From 6fab2adc09228920da10c51250ddd385aaf26655 Mon Sep 17 00:00:00 2001 From: Shreyan Date: Fri, 29 May 2026 13:24:35 +0530 Subject: [PATCH 1/2] Add standard_result S3 class for unified preprocessing return values --- base/workflow/NAMESPACE | 4 + base/workflow/R/standard_result.R | 179 ++++++++++++++ .../as.data.frame.pecan_preprocess_result.Rd | 19 ++ .../man/print.pecan_preprocess_result.Rd | 19 ++ base/workflow/man/standard_result.Rd | 55 +++++ base/workflow/man/validate_standard_result.Rd | 18 ++ .../tests/testthat/test-standard_result.R | 225 ++++++++++++++++++ 7 files changed, 519 insertions(+) create mode 100644 base/workflow/R/standard_result.R create mode 100644 base/workflow/man/as.data.frame.pecan_preprocess_result.Rd create mode 100644 base/workflow/man/print.pecan_preprocess_result.Rd create mode 100644 base/workflow/man/standard_result.Rd create mode 100644 base/workflow/man/validate_standard_result.Rd create mode 100644 base/workflow/tests/testthat/test-standard_result.R diff --git a/base/workflow/NAMESPACE b/base/workflow/NAMESPACE index c05f334c5d5..dc5c53203ef 100644 --- a/base/workflow/NAMESPACE +++ b/base/workflow/NAMESPACE @@ -1,10 +1,14 @@ # Generated by roxygen2: do not edit by hand +S3method(as.data.frame,pecan_preprocess_result) +S3method(print,pecan_preprocess_result) export(do_conversions) export(run.write.configs) export(runModule.get.trait.data) export(runModule.run.write.configs) export(runModule_start_model_runs) +export(standard_result) export(start_model_runs) +export(validate_standard_result) importFrom(dplyr,"%>%") importFrom(rlang,"%||%") diff --git a/base/workflow/R/standard_result.R b/base/workflow/R/standard_result.R new file mode 100644 index 00000000000..4439e247b61 --- /dev/null +++ b/base/workflow/R/standard_result.R @@ -0,0 +1,179 @@ +#' Standard Preprocessing Result Object +#' +#' @description +#' Construct a minimal, uniform result object for preprocessing functions. +#' This object is intended to standardize the current mix of return values such +#' as path strings, nested lists, and BETY identifier lists. +#' +#' @param tag Character scalar identifying the input type. One of +#' `"met"`, `"soil"`, `"ic"`, `"phenology"`, or `"fia"`. +#' @param paths Character vector of output file paths. +#' @param input_id Integer scalar BETY input ID, or `NA_integer_` when unused. +#' @param dbfile_id Integer scalar BETY dbfile ID, or `NA_integer_` when unused. +#' @param format Character scalar naming the output format. +#' @param source Character scalar naming the source dataset or provider. +#' @param status Character scalar. One of `"success"`, `"error"`, or +#' `"skipped"`. +#' @param error_message Character scalar or `NULL`. Error detail when +#' `status == "error"`. +#' +#' @return An object of class `pecan_preprocess_result`. +#' @export +#' +#' @examples +#' standard_result( +#' tag = "met", +#' paths = "/data/dbfiles/ERA5_772_2005.nc", +#' input_id = 42001L, +#' dbfile_id = 55003L, +#' format = "CF Meteorology", +#' source = "ERA5" +#' ) +standard_result <- function(tag, + paths = character(), + input_id = NA_integer_, + dbfile_id = NA_integer_, + format = "", + source = "", + status = "success", + error_message = NULL) { + result <- list( + tag = tag, + paths = as.character(paths), + input_id = as.integer(input_id), + dbfile_id = as.integer(dbfile_id), + format = format, + source = source, + status = status, + error_message = error_message + ) + + class(result) <- c("pecan_preprocess_result", "list") + validate_standard_result(result) +} + +#' Validate a Standard Preprocessing Result +#' +#' @description +#' Validate the structure and field types of a standard preprocessing result. +#' Returns the input object invisibly when valid and throws an error otherwise. +#' +#' @param x Object to validate. +#' +#' @return `x`, invisibly, when validation succeeds. +#' @export +validate_standard_result <- function(x) { + allowed_tags <- c("met", "soil", "ic", "phenology", "fia") + allowed_status <- c("success", "error", "skipped") + + if (!inherits(x, "pecan_preprocess_result")) { + stop("`x` must inherit from 'pecan_preprocess_result'.", call. = FALSE) + } + if (!is.list(x)) { + stop("`x` must be a list.", call. = FALSE) + } + if (!is.character(x$tag) || length(x$tag) != 1L || is.na(x$tag) || !(x$tag %in% allowed_tags)) { + stop("`tag` must be one of: met, soil, ic, phenology, fia.", call. = FALSE) + } + if (!is.character(x$paths)) { + stop("`paths` must be a character vector.", call. = FALSE) + } + if (!is.integer(x$input_id) || length(x$input_id) != 1L) { + stop("`input_id` must be an integer scalar.", call. = FALSE) + } + if (!is.integer(x$dbfile_id) || length(x$dbfile_id) != 1L) { + stop("`dbfile_id` must be an integer scalar.", call. = FALSE) + } + if (!is.character(x$format) || length(x$format) != 1L) { + stop("`format` must be a character scalar.", call. = FALSE) + } + if (!is.character(x$source) || length(x$source) != 1L) { + stop("`source` must be a character scalar.", call. = FALSE) + } + if (!is.character(x$status) || length(x$status) != 1L || !(x$status %in% allowed_status)) { + stop("`status` must be one of: success, error, skipped.", call. = FALSE) + } + if (!is.null(x$error_message) && (!is.character(x$error_message) || length(x$error_message) != 1L)) { + stop("`error_message` must be NULL or a character scalar.", call. = FALSE) + } + if (identical(x$status, "error") && is.null(x$error_message)) { + stop("`error_message` must be provided when `status` is 'error'.", call. = FALSE) + } + if (!identical(x$status, "error") && !is.null(x$error_message)) { + stop("`error_message` must be NULL unless `status` is 'error'.", call. = FALSE) + } + + # TODO: When callers migrate, validate caller-specific invariants here. + invisible(x) +} + +#' Print a Standard Preprocessing Result +#' +#' @param x A `pecan_preprocess_result` object. +#' @param ... Unused. +#' +#' @return `x`, invisibly. +#' @export +print.pecan_preprocess_result <- function(x, ...) { + validate_standard_result(x) + + cat(sprintf("PEcAn preprocessing result [%s]\n", x$tag)) + cat(sprintf(" status: %s\n", x$status)) + cat(sprintf(" source: %s\n", x$source)) + cat(sprintf(" format: %s\n", x$format)) + + if (length(x$paths) == 0L) { + cat(" paths: \n") + } else { + cat(sprintf(" paths: %s\n", paste(x$paths, collapse = ", "))) + } + + cat(sprintf( + " db_ids: input=%s, dbfile=%s\n", + ifelse(is.na(x$input_id), "NA", as.character(x$input_id)), + ifelse(is.na(x$dbfile_id), "NA", as.character(x$dbfile_id)) + )) + + if (identical(x$status, "error")) { + cat(sprintf(" error: %s\n", x$error_message)) + } + + # TODO: Expand printed details only after all preprocessors return this type. + invisible(x) +} + +#' Coerce a Standard Preprocessing Result to a Data Frame +#' +#' @param x A `pecan_preprocess_result` object. +#' @param ... Unused. +#' +#' @return A data frame with one row per path. +#' @export +as.data.frame.pecan_preprocess_result <- function(x, ...) { + validate_standard_result(x) + + n_paths <- length(x$paths) + if (n_paths == 0L) { + path_values <- NA_character_ + n_rows <- 1L + } else { + path_values <- x$paths + n_rows <- n_paths + } + + # TODO: Revisit row shape if callers need one row per result instead of per path. + data.frame( + tag = rep.int(x$tag, n_rows), + path = path_values, + input_id = rep.int(x$input_id, n_rows), + dbfile_id = rep.int(x$dbfile_id, n_rows), + format = rep.int(x$format, n_rows), + source = rep.int(x$source, n_rows), + status = rep.int(x$status, n_rows), + error_message = rep.int( + if (is.null(x$error_message)) NA_character_ else x$error_message, + n_rows + ), + stringsAsFactors = FALSE + ) +} \ No newline at end of file diff --git a/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd b/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd new file mode 100644 index 00000000000..d36b9f1d9b4 --- /dev/null +++ b/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standard_result.R +\name{as.data.frame.pecan_preprocess_result} +\alias{as.data.frame.pecan_preprocess_result} +\title{Coerce a Standard Preprocessing Result to a Data Frame} +\usage{ +\method{as.data.frame}{pecan_preprocess_result}(x, ...) +} +\arguments{ +\item{x}{A `pecan_preprocess_result` object.} + +\item{...}{Unused.} +} +\value{ +A data frame with one row per path. +} +\description{ +Coerce a Standard Preprocessing Result to a Data Frame +} diff --git a/base/workflow/man/print.pecan_preprocess_result.Rd b/base/workflow/man/print.pecan_preprocess_result.Rd new file mode 100644 index 00000000000..c0e0d313f64 --- /dev/null +++ b/base/workflow/man/print.pecan_preprocess_result.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standard_result.R +\name{print.pecan_preprocess_result} +\alias{print.pecan_preprocess_result} +\title{Print a Standard Preprocessing Result} +\usage{ +\method{print}{pecan_preprocess_result}(x, ...) +} +\arguments{ +\item{x}{A `pecan_preprocess_result` object.} + +\item{...}{Unused.} +} +\value{ +`x`, invisibly. +} +\description{ +Print a Standard Preprocessing Result +} diff --git a/base/workflow/man/standard_result.Rd b/base/workflow/man/standard_result.Rd new file mode 100644 index 00000000000..b600f5526eb --- /dev/null +++ b/base/workflow/man/standard_result.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standard_result.R +\name{standard_result} +\alias{standard_result} +\title{Standard Preprocessing Result Object} +\usage{ +standard_result( + tag, + paths = character(), + input_id = NA_integer_, + dbfile_id = NA_integer_, + format = "", + source = "", + status = "success", + error_message = NULL +) +} +\arguments{ +\item{tag}{Character scalar identifying the input type. One of +`"met"`, `"soil"`, `"ic"`, `"phenology"`, or `"fia"`.} + +\item{paths}{Character vector of output file paths.} + +\item{input_id}{Integer scalar BETY input ID, or `NA_integer_` when unused.} + +\item{dbfile_id}{Integer scalar BETY dbfile ID, or `NA_integer_` when unused.} + +\item{format}{Character scalar naming the output format.} + +\item{source}{Character scalar naming the source dataset or provider.} + +\item{status}{Character scalar. One of `"success"`, `"error"`, or +`"skipped"`.} + +\item{error_message}{Character scalar or `NULL`. Error detail when +`status == "error"`.} +} +\value{ +An object of class `pecan_preprocess_result`. +} +\description{ +Construct a minimal, uniform result object for preprocessing functions. +This object is intended to standardize the current mix of return values such +as path strings, nested lists, and BETY identifier lists. +} +\examples{ +standard_result( + tag = "met", + paths = "/data/dbfiles/ERA5_772_2005.nc", + input_id = 42001L, + dbfile_id = 55003L, + format = "CF Meteorology", + source = "ERA5" +) +} diff --git a/base/workflow/man/validate_standard_result.Rd b/base/workflow/man/validate_standard_result.Rd new file mode 100644 index 00000000000..372a9864155 --- /dev/null +++ b/base/workflow/man/validate_standard_result.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/standard_result.R +\name{validate_standard_result} +\alias{validate_standard_result} +\title{Validate a Standard Preprocessing Result} +\usage{ +validate_standard_result(x) +} +\arguments{ +\item{x}{Object to validate.} +} +\value{ +`x`, invisibly, when validation succeeds. +} +\description{ +Validate the structure and field types of a standard preprocessing result. +Returns the input object invisibly when valid and throws an error otherwise. +} diff --git a/base/workflow/tests/testthat/test-standard_result.R b/base/workflow/tests/testthat/test-standard_result.R new file mode 100644 index 00000000000..e5d9d9daa94 --- /dev/null +++ b/base/workflow/tests/testthat/test-standard_result.R @@ -0,0 +1,225 @@ +context("standard_result") + +if (!exists("standard_result", mode = "function")) { + standard_result_candidates <- c( + "base/workflow/R/standard_result.R", + "R/standard_result.R", + "../../R/standard_result.R", + "/Users/hm/Desktop/pecan/base/workflow/R/standard_result.R" + ) + standard_result_path <- standard_result_candidates[file.exists(standard_result_candidates)][1] + + if (is.na(standard_result_path)) { + stop("Unable to locate standard_result.R for direct test execution.", call. = FALSE) + } + + source(standard_result_path) +} + +test_that("standard_result creates valid object", { + r <- standard_result( + tag = "met", + paths = "/tmp/test.nc", + input_id = 42L, + dbfile_id = 99L, + format = "CF Meteorology", + source = "ERA5" + ) + + expect_s3_class(r, "pecan_preprocess_result") + expect_equal(r$tag, "met") + expect_equal(r$paths, "/tmp/test.nc") + expect_equal(r$input_id, 42L) + expect_equal(r$dbfile_id, 99L) + expect_equal(r$format, "CF Meteorology") + expect_equal(r$source, "ERA5") + expect_equal(r$status, "success") + expect_null(r$error_message) +}) + +test_that("standard_result coerces ids to integer for compatibility", { + r <- standard_result( + tag = "met", + input_id = 42, + dbfile_id = 99, + source = "ERA5" + ) + + expect_type(r$input_id, "integer") + expect_type(r$dbfile_id, "integer") + expect_equal(r$input_id, 42L) + expect_equal(r$dbfile_id, 99L) +}) + +test_that("standard_result validates tag inputs", { + expect_error(standard_result(tag = "invalid")) + expect_error(standard_result(tag = 123)) + expect_error(standard_result(tag = c("met", "soil"))) +}) + +test_that("standard_result handles empty values", { + r <- standard_result(tag = "soil") + + expect_equal(r$paths, character()) + expect_true(is.na(r$input_id)) + expect_true(is.na(r$dbfile_id)) + expect_equal(r$format, "") + expect_equal(r$source, "") + expect_equal(r$status, "success") +}) + +test_that("standard_result handles error status", { + r <- standard_result( + tag = "met", + status = "error", + error_message = "download failed" + ) + + expect_equal(r$status, "error") + expect_equal(r$error_message, "download failed") +}) + +test_that("validate_standard_result returns object invisibly when valid", { + r <- standard_result(tag = "met", status = "skipped") + + expect_identical(validate_standard_result(r), r) +}) + +test_that("validate_standard_result rejects invalid objects and values", { + valid <- standard_result(tag = "met", source = "ERA5") + + expect_error(validate_standard_result(list())) + + no_class <- valid + class(no_class) <- "list" + expect_error(validate_standard_result(no_class), "must inherit") + + bad_paths <- valid + bad_paths$paths <- 1 + expect_error(validate_standard_result(bad_paths), "paths") + + bad_input_id <- valid + bad_input_id$input_id <- c(1L, 2L) + expect_error(validate_standard_result(bad_input_id), "input_id") + + bad_dbfile_id <- valid + bad_dbfile_id$dbfile_id <- "99" + expect_error(validate_standard_result(bad_dbfile_id), "dbfile_id") + + bad_format <- valid + bad_format$format <- character() + expect_error(validate_standard_result(bad_format), "format") + + bad_source <- valid + bad_source$source <- c("ERA5", "NARR") + expect_error(validate_standard_result(bad_source), "source") + + bad_status <- valid + bad_status$status <- "done" + expect_error(validate_standard_result(bad_status), "status") + + missing_error_message <- valid + missing_error_message$status <- "error" + expect_error(validate_standard_result(missing_error_message), "error_message") + + unexpected_error_message <- valid + unexpected_error_message$error_message <- "boom" + expect_error(validate_standard_result(unexpected_error_message), "error_message") + + bad_error_message_type <- valid + bad_error_message_type$status <- "error" + bad_error_message_type$error_message <- 1 + expect_error(validate_standard_result(bad_error_message_type), "error_message") +}) + +test_that("print.pecan_preprocess_result outputs expected format for populated result", { + r <- standard_result(tag = "met", source = "ERA5", paths = "/tmp/test.nc") + + output <- capture.output(print(r)) + + expect_match(output[1], "PEcAn preprocessing result \\[met\\]") + expect_match(output[2], "status: success") + expect_match(output[3], "source: ERA5") + expect_match(output[5], "paths: /tmp/test.nc") +}) + +test_that("print.pecan_preprocess_result handles empty paths and errors", { + skipped <- standard_result(tag = "soil", status = "skipped") + skipped_output <- capture.output(print(skipped)) + expect_match(skipped_output[5], "paths: ") + + errored <- standard_result( + tag = "met", + status = "error", + error_message = "download failed" + ) + error_output <- capture.output(print(errored)) + expect_true(any(grepl("error: download failed", error_output))) +}) + +test_that("as.data.frame.pecan_preprocess_result expands one row per path", { + r <- standard_result( + tag = "met", + paths = c("/tmp/a.nc", "/tmp/b.nc"), + input_id = 1L, + source = "ERA5" + ) + + df <- as.data.frame(r) + expect_equal(nrow(df), 2) + expect_equal(df$tag, c("met", "met")) + expect_equal(df$path, c("/tmp/a.nc", "/tmp/b.nc")) + expect_equal(df$input_id, c(1L, 1L)) + expect_equal(df$error_message, c(NA_character_, NA_character_)) +}) + +test_that("as.data.frame.pecan_preprocess_result handles empty paths", { + r <- standard_result(tag = "soil") + + df <- as.data.frame(r) + expect_equal(nrow(df), 1) + expect_equal(df$tag, "soil") + expect_true(is.na(df$path)) + expect_true(is.na(df$error_message)) +}) + +test_that("standard_result serialization preserves the contract", { + r <- standard_result( + tag = "met", + paths = c("/tmp/a.nc", "/tmp/b.nc"), + input_id = 10L, + dbfile_id = 20L, + format = "CF Meteorology", + source = "ERA5", + status = "success" + ) + + restored <- unserialize(serialize(r, NULL)) + + expect_s3_class(restored, "pecan_preprocess_result") + expect_identical(restored, r) + expect_identical(validate_standard_result(restored), restored) +}) + +test_that("backward compatibility supports legacy-shaped classed lists", { + legacy <- list( + tag = "met", + paths = "/tmp/test.nc", + input_id = 1L, + dbfile_id = NA_integer_, + format = "CF Meteorology", + source = "ERA5", + status = "success", + error_message = NULL + ) + class(legacy) <- c("pecan_preprocess_result", "list") + + expect_identical(validate_standard_result(legacy), legacy) + expect_equal(as.data.frame(legacy)$path, "/tmp/test.nc") +}) + +test_that("invalid constructor values fail fast", { + expect_error(standard_result(tag = "met", status = "error"), "error_message") + expect_error(standard_result(tag = "met", status = "success", error_message = "boom"), "error_message") + expect_error(standard_result(tag = "met", status = "unknown"), "status") +}) \ No newline at end of file From 081e4116e09d711382318cd25c3dee5a0ad97316 Mon Sep 17 00:00:00 2001 From: Shreyan Date: Tue, 9 Jun 2026 13:34:05 +0530 Subject: [PATCH 2/2] Refactor preprocessing result abstraction based on review feedback --- base/workflow/DESCRIPTION | 2 +- base/workflow/NAMESPACE | 7 +- base/workflow/R/preprocess_result.R | 140 +++++++++++ base/workflow/R/standard_result.R | 179 -------------- .../as.data.frame.pecan_preprocess_result.Rd | 19 -- base/workflow/man/insert_preprocess_result.Rd | 22 ++ base/workflow/man/preprocess_result.Rd | 53 +++++ .../man/print.pecan_preprocess_result.Rd | 19 -- base/workflow/man/standard_result.Rd | 55 ----- .../man/validate_preprocess_result.Rd | 20 ++ base/workflow/man/validate_standard_result.Rd | 18 -- .../tests/testthat/test-preprocess_result.R | 101 ++++++++ .../tests/testthat/test-standard_result.R | 225 ------------------ 13 files changed, 340 insertions(+), 520 deletions(-) create mode 100644 base/workflow/R/preprocess_result.R delete mode 100644 base/workflow/R/standard_result.R delete mode 100644 base/workflow/man/as.data.frame.pecan_preprocess_result.Rd create mode 100644 base/workflow/man/insert_preprocess_result.Rd create mode 100644 base/workflow/man/preprocess_result.Rd delete mode 100644 base/workflow/man/print.pecan_preprocess_result.Rd delete mode 100644 base/workflow/man/standard_result.Rd create mode 100644 base/workflow/man/validate_preprocess_result.Rd delete mode 100644 base/workflow/man/validate_standard_result.Rd create mode 100644 base/workflow/tests/testthat/test-preprocess_result.R delete mode 100644 base/workflow/tests/testthat/test-standard_result.R diff --git a/base/workflow/DESCRIPTION b/base/workflow/DESCRIPTION index 1d0ca83bd70..942bb74ce54 100644 --- a/base/workflow/DESCRIPTION +++ b/base/workflow/DESCRIPTION @@ -48,5 +48,5 @@ Suggests: withr Copyright: Authors Encoding: UTF-8 -RoxygenNote: 7.3.3 X-schema.org-keywords: PEcAn, data-assimilation, ecosystem-modeling, reproducibility +Config/roxygen2/version: 8.0.0 diff --git a/base/workflow/NAMESPACE b/base/workflow/NAMESPACE index dc5c53203ef..0f324aefd21 100644 --- a/base/workflow/NAMESPACE +++ b/base/workflow/NAMESPACE @@ -1,14 +1,13 @@ # Generated by roxygen2: do not edit by hand -S3method(as.data.frame,pecan_preprocess_result) -S3method(print,pecan_preprocess_result) export(do_conversions) +export(insert_preprocess_result) +export(preprocess_result) export(run.write.configs) export(runModule.get.trait.data) export(runModule.run.write.configs) export(runModule_start_model_runs) -export(standard_result) export(start_model_runs) -export(validate_standard_result) +export(validate_preprocess_result) importFrom(dplyr,"%>%") importFrom(rlang,"%||%") diff --git a/base/workflow/R/preprocess_result.R b/base/workflow/R/preprocess_result.R new file mode 100644 index 00000000000..f5ac3c84bc7 --- /dev/null +++ b/base/workflow/R/preprocess_result.R @@ -0,0 +1,140 @@ +#' Preprocessing Result Constructor +#' +#' Uniform return type for all preprocessing pipeline functions. +#' Returns a named list that can be inserted directly into a PEcAn settings object. +#' Disk-only for now; memory-primary path can be added later without breaking +#' the interface. +#' +#' @param file Character. Path to the generated file. +#' @param format Character. Format identifier (e.g., "CFmet", "ED2met"). +#' @param mimetype Character. MIME type of the file. +#' @param dbfile.id Integer. BETY dbfile ID, if available. NULL if dbparms = NULL. +#' @param start_date POSIXct. Start date of the data period. +#' @param end_date POSIXct. End date of the data period. +#' @param source Character. Data source identifier (e.g., "Ameriflux", "CRUNCEP"). +#' +#' @return A named list with class attribute "preprocess_result" for potential +#' future subclassing, but behaves as a plain list for now. +#' +#' @examples +#' result <- preprocess_result( +#' file = "/data/flux/US-NR1.2004.nc", +#' format = "CFmet", +#' mimetype = "application/x-netcdf", +#' dbfile.id = 12345, +#' start_date = as.POSIXct("2004-01-01"), +#' end_date = as.POSIXct("2004-12-31"), +#' source = "Ameriflux" +#' ) +#' +#' @md +#' @export +preprocess_result <- function(file, format, mimetype, dbfile.id = NULL, + start_date = NULL, end_date = NULL, source = NULL) { + # Validation - using PEcAn.logger::logger.severe() for consistency with codebase + if (!is.character(file) || length(file) != 1) { + PEcAn.logger::logger.severe("file must be a single character path") + } + if (!file.exists(file)) { + PEcAn.logger::logger.warn("file does not exist:", file) + } + if (!is.character(format) || length(format) != 1) { + PEcAn.logger::logger.severe("format must be a single character string") + } + if (!is.character(mimetype) || length(mimetype) != 1) { + PEcAn.logger::logger.severe("mimetype must be a single character string") + } + if (!is.null(dbfile.id) && (!is.numeric(dbfile.id) || length(dbfile.id) != 1)) { + PEcAn.logger::logger.severe("dbfile.id must be a single integer or NULL") + } + + result <- list( + file = file, + format = format, + mimetype = mimetype, + dbfile.id = dbfile.id, + start_date = start_date, + end_date = end_date, + source = source + ) + + # Class attribute for future subclassing, but no S3 methods yet + class(result) <- c("preprocess_result", "list") + + result +} + +#' Insert Preprocess Result into Settings +#' +#' Takes a preprocess_result (or list of them) and patches it into the +#' appropriate location in a PEcAn settings object. +#' +#' @param settings List. PEcAn settings object. +#' @param result preprocess_result or list of preprocess_result. +#' @param input.type Character. Input type identifier, e.g., "met", "soil". +#' +#' @return Updated settings object. +#' +#' @md +#' @export +insert_preprocess_result <- function(settings, result, input.type) { + if (!is.list(result)) { + PEcAn.logger::logger.severe("result must be a list or preprocess_result") + } + + # Handle single result or list of results + if (inherits(result, "preprocess_result")) { + result <- list(result) + } + + # Ensure path exists in settings + if (is.null(settings$run$inputs)) { + settings$run$inputs <- list() + } + if (is.null(settings$run$inputs[[input.type]])) { + settings$run$inputs[[input.type]] <- list() + } + + # Insert results + settings$run$inputs[[input.type]]$path <- sapply(result, `[[`, "file") + settings$run$inputs[[input.type]]$format <- result[[1]]$format + settings$run$inputs[[input.type]]$mimetype <- result[[1]]$mimetype + + if (!is.null(result[[1]]$dbfile.id)) { + settings$run$inputs[[input.type]]$dbfile.id <- sapply(result, `[[`, "dbfile.id") + } + + settings +} + +#' Validate Preprocess Result +#' +#' Check that a preprocess_result has all required fields and valid values. +#' Useful for parity tests and pipeline validation. +#' +#' @param result List. Object to validate. +#' @param require.file.exists Logical. Whether to check file existence. +#' +#' @return Logical. TRUE if valid, throws error otherwise. +#' +#' @md +#' @export +validate_preprocess_result <- function(result, require.file.exists = TRUE) { + required_fields <- c("file", "format", "mimetype") + + for (field in required_fields) { + if (is.null(result[[field]])) { + PEcAn.logger::logger.severe("Missing required field:", field) + } + } + + if (!is.character(result$file) || length(result$file) != 1) { + PEcAn.logger::logger.severe("file must be a single character path") + } + + if (require.file.exists && !file.exists(result$file)) { + PEcAn.logger::logger.severe("file does not exist:", result$file) + } + + TRUE +} diff --git a/base/workflow/R/standard_result.R b/base/workflow/R/standard_result.R deleted file mode 100644 index 4439e247b61..00000000000 --- a/base/workflow/R/standard_result.R +++ /dev/null @@ -1,179 +0,0 @@ -#' Standard Preprocessing Result Object -#' -#' @description -#' Construct a minimal, uniform result object for preprocessing functions. -#' This object is intended to standardize the current mix of return values such -#' as path strings, nested lists, and BETY identifier lists. -#' -#' @param tag Character scalar identifying the input type. One of -#' `"met"`, `"soil"`, `"ic"`, `"phenology"`, or `"fia"`. -#' @param paths Character vector of output file paths. -#' @param input_id Integer scalar BETY input ID, or `NA_integer_` when unused. -#' @param dbfile_id Integer scalar BETY dbfile ID, or `NA_integer_` when unused. -#' @param format Character scalar naming the output format. -#' @param source Character scalar naming the source dataset or provider. -#' @param status Character scalar. One of `"success"`, `"error"`, or -#' `"skipped"`. -#' @param error_message Character scalar or `NULL`. Error detail when -#' `status == "error"`. -#' -#' @return An object of class `pecan_preprocess_result`. -#' @export -#' -#' @examples -#' standard_result( -#' tag = "met", -#' paths = "/data/dbfiles/ERA5_772_2005.nc", -#' input_id = 42001L, -#' dbfile_id = 55003L, -#' format = "CF Meteorology", -#' source = "ERA5" -#' ) -standard_result <- function(tag, - paths = character(), - input_id = NA_integer_, - dbfile_id = NA_integer_, - format = "", - source = "", - status = "success", - error_message = NULL) { - result <- list( - tag = tag, - paths = as.character(paths), - input_id = as.integer(input_id), - dbfile_id = as.integer(dbfile_id), - format = format, - source = source, - status = status, - error_message = error_message - ) - - class(result) <- c("pecan_preprocess_result", "list") - validate_standard_result(result) -} - -#' Validate a Standard Preprocessing Result -#' -#' @description -#' Validate the structure and field types of a standard preprocessing result. -#' Returns the input object invisibly when valid and throws an error otherwise. -#' -#' @param x Object to validate. -#' -#' @return `x`, invisibly, when validation succeeds. -#' @export -validate_standard_result <- function(x) { - allowed_tags <- c("met", "soil", "ic", "phenology", "fia") - allowed_status <- c("success", "error", "skipped") - - if (!inherits(x, "pecan_preprocess_result")) { - stop("`x` must inherit from 'pecan_preprocess_result'.", call. = FALSE) - } - if (!is.list(x)) { - stop("`x` must be a list.", call. = FALSE) - } - if (!is.character(x$tag) || length(x$tag) != 1L || is.na(x$tag) || !(x$tag %in% allowed_tags)) { - stop("`tag` must be one of: met, soil, ic, phenology, fia.", call. = FALSE) - } - if (!is.character(x$paths)) { - stop("`paths` must be a character vector.", call. = FALSE) - } - if (!is.integer(x$input_id) || length(x$input_id) != 1L) { - stop("`input_id` must be an integer scalar.", call. = FALSE) - } - if (!is.integer(x$dbfile_id) || length(x$dbfile_id) != 1L) { - stop("`dbfile_id` must be an integer scalar.", call. = FALSE) - } - if (!is.character(x$format) || length(x$format) != 1L) { - stop("`format` must be a character scalar.", call. = FALSE) - } - if (!is.character(x$source) || length(x$source) != 1L) { - stop("`source` must be a character scalar.", call. = FALSE) - } - if (!is.character(x$status) || length(x$status) != 1L || !(x$status %in% allowed_status)) { - stop("`status` must be one of: success, error, skipped.", call. = FALSE) - } - if (!is.null(x$error_message) && (!is.character(x$error_message) || length(x$error_message) != 1L)) { - stop("`error_message` must be NULL or a character scalar.", call. = FALSE) - } - if (identical(x$status, "error") && is.null(x$error_message)) { - stop("`error_message` must be provided when `status` is 'error'.", call. = FALSE) - } - if (!identical(x$status, "error") && !is.null(x$error_message)) { - stop("`error_message` must be NULL unless `status` is 'error'.", call. = FALSE) - } - - # TODO: When callers migrate, validate caller-specific invariants here. - invisible(x) -} - -#' Print a Standard Preprocessing Result -#' -#' @param x A `pecan_preprocess_result` object. -#' @param ... Unused. -#' -#' @return `x`, invisibly. -#' @export -print.pecan_preprocess_result <- function(x, ...) { - validate_standard_result(x) - - cat(sprintf("PEcAn preprocessing result [%s]\n", x$tag)) - cat(sprintf(" status: %s\n", x$status)) - cat(sprintf(" source: %s\n", x$source)) - cat(sprintf(" format: %s\n", x$format)) - - if (length(x$paths) == 0L) { - cat(" paths: \n") - } else { - cat(sprintf(" paths: %s\n", paste(x$paths, collapse = ", "))) - } - - cat(sprintf( - " db_ids: input=%s, dbfile=%s\n", - ifelse(is.na(x$input_id), "NA", as.character(x$input_id)), - ifelse(is.na(x$dbfile_id), "NA", as.character(x$dbfile_id)) - )) - - if (identical(x$status, "error")) { - cat(sprintf(" error: %s\n", x$error_message)) - } - - # TODO: Expand printed details only after all preprocessors return this type. - invisible(x) -} - -#' Coerce a Standard Preprocessing Result to a Data Frame -#' -#' @param x A `pecan_preprocess_result` object. -#' @param ... Unused. -#' -#' @return A data frame with one row per path. -#' @export -as.data.frame.pecan_preprocess_result <- function(x, ...) { - validate_standard_result(x) - - n_paths <- length(x$paths) - if (n_paths == 0L) { - path_values <- NA_character_ - n_rows <- 1L - } else { - path_values <- x$paths - n_rows <- n_paths - } - - # TODO: Revisit row shape if callers need one row per result instead of per path. - data.frame( - tag = rep.int(x$tag, n_rows), - path = path_values, - input_id = rep.int(x$input_id, n_rows), - dbfile_id = rep.int(x$dbfile_id, n_rows), - format = rep.int(x$format, n_rows), - source = rep.int(x$source, n_rows), - status = rep.int(x$status, n_rows), - error_message = rep.int( - if (is.null(x$error_message)) NA_character_ else x$error_message, - n_rows - ), - stringsAsFactors = FALSE - ) -} \ No newline at end of file diff --git a/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd b/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd deleted file mode 100644 index d36b9f1d9b4..00000000000 --- a/base/workflow/man/as.data.frame.pecan_preprocess_result.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/standard_result.R -\name{as.data.frame.pecan_preprocess_result} -\alias{as.data.frame.pecan_preprocess_result} -\title{Coerce a Standard Preprocessing Result to a Data Frame} -\usage{ -\method{as.data.frame}{pecan_preprocess_result}(x, ...) -} -\arguments{ -\item{x}{A `pecan_preprocess_result` object.} - -\item{...}{Unused.} -} -\value{ -A data frame with one row per path. -} -\description{ -Coerce a Standard Preprocessing Result to a Data Frame -} diff --git a/base/workflow/man/insert_preprocess_result.Rd b/base/workflow/man/insert_preprocess_result.Rd new file mode 100644 index 00000000000..151f9914cca --- /dev/null +++ b/base/workflow/man/insert_preprocess_result.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/preprocess_result.R +\name{insert_preprocess_result} +\alias{insert_preprocess_result} +\title{Insert Preprocess Result into Settings} +\usage{ +insert_preprocess_result(settings, result, input.type) +} +\arguments{ +\item{settings}{List. PEcAn settings object.} + +\item{result}{preprocess_result or list of preprocess_result.} + +\item{input.type}{Character. Input type identifier, e.g., "met", "soil".} +} +\value{ +Updated settings object. +} +\description{ +Takes a preprocess_result (or list of them) and patches it into the +appropriate location in a PEcAn settings object. +} diff --git a/base/workflow/man/preprocess_result.Rd b/base/workflow/man/preprocess_result.Rd new file mode 100644 index 00000000000..d4070711706 --- /dev/null +++ b/base/workflow/man/preprocess_result.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/preprocess_result.R +\name{preprocess_result} +\alias{preprocess_result} +\title{Preprocessing Result Constructor} +\usage{ +preprocess_result( + file, + format, + mimetype, + dbfile.id = NULL, + start_date = NULL, + end_date = NULL, + source = NULL +) +} +\arguments{ +\item{file}{Character. Path to the generated file.} + +\item{format}{Character. Format identifier (e.g., "CFmet", "ED2met").} + +\item{mimetype}{Character. MIME type of the file.} + +\item{dbfile.id}{Integer. BETY dbfile ID, if available. NULL if dbparms = NULL.} + +\item{start_date}{POSIXct. Start date of the data period.} + +\item{end_date}{POSIXct. End date of the data period.} + +\item{source}{Character. Data source identifier (e.g., "Ameriflux", "CRUNCEP").} +} +\value{ +A named list with class attribute "preprocess_result" for potential +future subclassing, but behaves as a plain list for now. +} +\description{ +Uniform return type for all preprocessing pipeline functions. +Returns a named list that can be inserted directly into a PEcAn settings object. +Disk-only for now; memory-primary path can be added later without breaking +the interface. +} +\examples{ +result <- preprocess_result( + file = "/data/flux/US-NR1.2004.nc", + format = "CFmet", + mimetype = "application/x-netcdf", + dbfile.id = 12345, + start_date = as.POSIXct("2004-01-01"), + end_date = as.POSIXct("2004-12-31"), + source = "Ameriflux" +) + +} diff --git a/base/workflow/man/print.pecan_preprocess_result.Rd b/base/workflow/man/print.pecan_preprocess_result.Rd deleted file mode 100644 index c0e0d313f64..00000000000 --- a/base/workflow/man/print.pecan_preprocess_result.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/standard_result.R -\name{print.pecan_preprocess_result} -\alias{print.pecan_preprocess_result} -\title{Print a Standard Preprocessing Result} -\usage{ -\method{print}{pecan_preprocess_result}(x, ...) -} -\arguments{ -\item{x}{A `pecan_preprocess_result` object.} - -\item{...}{Unused.} -} -\value{ -`x`, invisibly. -} -\description{ -Print a Standard Preprocessing Result -} diff --git a/base/workflow/man/standard_result.Rd b/base/workflow/man/standard_result.Rd deleted file mode 100644 index b600f5526eb..00000000000 --- a/base/workflow/man/standard_result.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/standard_result.R -\name{standard_result} -\alias{standard_result} -\title{Standard Preprocessing Result Object} -\usage{ -standard_result( - tag, - paths = character(), - input_id = NA_integer_, - dbfile_id = NA_integer_, - format = "", - source = "", - status = "success", - error_message = NULL -) -} -\arguments{ -\item{tag}{Character scalar identifying the input type. One of -`"met"`, `"soil"`, `"ic"`, `"phenology"`, or `"fia"`.} - -\item{paths}{Character vector of output file paths.} - -\item{input_id}{Integer scalar BETY input ID, or `NA_integer_` when unused.} - -\item{dbfile_id}{Integer scalar BETY dbfile ID, or `NA_integer_` when unused.} - -\item{format}{Character scalar naming the output format.} - -\item{source}{Character scalar naming the source dataset or provider.} - -\item{status}{Character scalar. One of `"success"`, `"error"`, or -`"skipped"`.} - -\item{error_message}{Character scalar or `NULL`. Error detail when -`status == "error"`.} -} -\value{ -An object of class `pecan_preprocess_result`. -} -\description{ -Construct a minimal, uniform result object for preprocessing functions. -This object is intended to standardize the current mix of return values such -as path strings, nested lists, and BETY identifier lists. -} -\examples{ -standard_result( - tag = "met", - paths = "/data/dbfiles/ERA5_772_2005.nc", - input_id = 42001L, - dbfile_id = 55003L, - format = "CF Meteorology", - source = "ERA5" -) -} diff --git a/base/workflow/man/validate_preprocess_result.Rd b/base/workflow/man/validate_preprocess_result.Rd new file mode 100644 index 00000000000..570a107c7e4 --- /dev/null +++ b/base/workflow/man/validate_preprocess_result.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/preprocess_result.R +\name{validate_preprocess_result} +\alias{validate_preprocess_result} +\title{Validate Preprocess Result} +\usage{ +validate_preprocess_result(result, require.file.exists = TRUE) +} +\arguments{ +\item{result}{List. Object to validate.} + +\item{require.file.exists}{Logical. Whether to check file existence.} +} +\value{ +Logical. TRUE if valid, throws error otherwise. +} +\description{ +Check that a preprocess_result has all required fields and valid values. +Useful for parity tests and pipeline validation. +} diff --git a/base/workflow/man/validate_standard_result.Rd b/base/workflow/man/validate_standard_result.Rd deleted file mode 100644 index 372a9864155..00000000000 --- a/base/workflow/man/validate_standard_result.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/standard_result.R -\name{validate_standard_result} -\alias{validate_standard_result} -\title{Validate a Standard Preprocessing Result} -\usage{ -validate_standard_result(x) -} -\arguments{ -\item{x}{Object to validate.} -} -\value{ -`x`, invisibly, when validation succeeds. -} -\description{ -Validate the structure and field types of a standard preprocessing result. -Returns the input object invisibly when valid and throws an error otherwise. -} diff --git a/base/workflow/tests/testthat/test-preprocess_result.R b/base/workflow/tests/testthat/test-preprocess_result.R new file mode 100644 index 00000000000..66fe5e7e24a --- /dev/null +++ b/base/workflow/tests/testthat/test-preprocess_result.R @@ -0,0 +1,101 @@ + +context("Preprocess Result Constructor") + +test_that("preprocess_result creates valid object", { + tmpfile <- tempfile(fileext = ".nc") + file.create(tmpfile) + on.exit(unlink(tmpfile)) + + result <- preprocess_result( + file = tmpfile, + format = "CFmet", + mimetype = "application/x-netcdf", + dbfile.id = 12345, + start_date = as.POSIXct("2004-01-01"), + end_date = as.POSIXct("2004-12-31"), + source = "Ameriflux" + ) + + expect_type(result, "list") + expect_equal(result$file, tmpfile) + expect_equal(result$format, "CFmet") + expect_equal(result$dbfile.id, 12345) + expect_s3_class(result, "preprocess_result") + expect_s3_class(result, "list") +}) + +test_that("preprocess_result validates inputs with logger.severe", { + # logger.severe stops execution, so we expect error + expect_error( + preprocess_result(file = 123, format = "CFmet", mimetype = "application/x-netcdf"), + "file must be a single character path" + ) + + expect_error( + preprocess_result(file = "foo.nc", format = NULL, mimetype = "application/x-netcdf"), + "format must be a single character string" + ) +}) + +test_that("preprocess_result accepts missing files", { + result <- preprocess_result( + file = "/nonexistent/file.nc", + format = "CFmet", + mimetype = "application/x-netcdf" + ) + + expect_equal(result$file, "/nonexistent/file.nc") +}) + +test_that("insert_preprocess_result patches settings correctly", { + settings <- list(run = list(inputs = list())) + tmpfile <- tempfile(fileext = ".nc") + file.create(tmpfile) + on.exit(unlink(tmpfile)) + + result <- preprocess_result( + file = tmpfile, + format = "CFmet", + mimetype = "application/x-netcdf" + ) + + updated <- insert_preprocess_result(settings, result, "met") + + expect_equal(updated$run$inputs$met$path, tmpfile) + expect_equal(updated$run$inputs$met$format, "CFmet") +}) + +test_that("insert_preprocess_result handles multiple results", { + settings <- list(run = list(inputs = list())) + tmpfile1 <- tempfile(fileext = ".nc") + tmpfile2 <- tempfile(fileext = ".nc") + file.create(tmpfile1) + file.create(tmpfile2) + on.exit({ + unlink(tmpfile1) + unlink(tmpfile2) + }) + + results <- list( + preprocess_result(file = tmpfile1, format = "CFmet", mimetype = "application/x-netcdf"), + preprocess_result(file = tmpfile2, format = "CFmet", mimetype = "application/x-netcdf") + ) + + updated <- insert_preprocess_result(settings, results, "met") + + expect_equal(updated$run$inputs$met$path, c(tmpfile1, tmpfile2)) +}) + +test_that("validate_preprocess_result catches invalid results", { + expect_error( + validate_preprocess_result(list(format = "CFmet")), + "Missing required field: file" + ) + + tmpfile <- tempfile() + file.create(tmpfile) + on.exit(unlink(tmpfile)) + + valid <- preprocess_result(file = tmpfile, format = "CFmet", mimetype = "application/x-netcdf") + expect_true(validate_preprocess_result(valid)) +}) \ No newline at end of file diff --git a/base/workflow/tests/testthat/test-standard_result.R b/base/workflow/tests/testthat/test-standard_result.R deleted file mode 100644 index e5d9d9daa94..00000000000 --- a/base/workflow/tests/testthat/test-standard_result.R +++ /dev/null @@ -1,225 +0,0 @@ -context("standard_result") - -if (!exists("standard_result", mode = "function")) { - standard_result_candidates <- c( - "base/workflow/R/standard_result.R", - "R/standard_result.R", - "../../R/standard_result.R", - "/Users/hm/Desktop/pecan/base/workflow/R/standard_result.R" - ) - standard_result_path <- standard_result_candidates[file.exists(standard_result_candidates)][1] - - if (is.na(standard_result_path)) { - stop("Unable to locate standard_result.R for direct test execution.", call. = FALSE) - } - - source(standard_result_path) -} - -test_that("standard_result creates valid object", { - r <- standard_result( - tag = "met", - paths = "/tmp/test.nc", - input_id = 42L, - dbfile_id = 99L, - format = "CF Meteorology", - source = "ERA5" - ) - - expect_s3_class(r, "pecan_preprocess_result") - expect_equal(r$tag, "met") - expect_equal(r$paths, "/tmp/test.nc") - expect_equal(r$input_id, 42L) - expect_equal(r$dbfile_id, 99L) - expect_equal(r$format, "CF Meteorology") - expect_equal(r$source, "ERA5") - expect_equal(r$status, "success") - expect_null(r$error_message) -}) - -test_that("standard_result coerces ids to integer for compatibility", { - r <- standard_result( - tag = "met", - input_id = 42, - dbfile_id = 99, - source = "ERA5" - ) - - expect_type(r$input_id, "integer") - expect_type(r$dbfile_id, "integer") - expect_equal(r$input_id, 42L) - expect_equal(r$dbfile_id, 99L) -}) - -test_that("standard_result validates tag inputs", { - expect_error(standard_result(tag = "invalid")) - expect_error(standard_result(tag = 123)) - expect_error(standard_result(tag = c("met", "soil"))) -}) - -test_that("standard_result handles empty values", { - r <- standard_result(tag = "soil") - - expect_equal(r$paths, character()) - expect_true(is.na(r$input_id)) - expect_true(is.na(r$dbfile_id)) - expect_equal(r$format, "") - expect_equal(r$source, "") - expect_equal(r$status, "success") -}) - -test_that("standard_result handles error status", { - r <- standard_result( - tag = "met", - status = "error", - error_message = "download failed" - ) - - expect_equal(r$status, "error") - expect_equal(r$error_message, "download failed") -}) - -test_that("validate_standard_result returns object invisibly when valid", { - r <- standard_result(tag = "met", status = "skipped") - - expect_identical(validate_standard_result(r), r) -}) - -test_that("validate_standard_result rejects invalid objects and values", { - valid <- standard_result(tag = "met", source = "ERA5") - - expect_error(validate_standard_result(list())) - - no_class <- valid - class(no_class) <- "list" - expect_error(validate_standard_result(no_class), "must inherit") - - bad_paths <- valid - bad_paths$paths <- 1 - expect_error(validate_standard_result(bad_paths), "paths") - - bad_input_id <- valid - bad_input_id$input_id <- c(1L, 2L) - expect_error(validate_standard_result(bad_input_id), "input_id") - - bad_dbfile_id <- valid - bad_dbfile_id$dbfile_id <- "99" - expect_error(validate_standard_result(bad_dbfile_id), "dbfile_id") - - bad_format <- valid - bad_format$format <- character() - expect_error(validate_standard_result(bad_format), "format") - - bad_source <- valid - bad_source$source <- c("ERA5", "NARR") - expect_error(validate_standard_result(bad_source), "source") - - bad_status <- valid - bad_status$status <- "done" - expect_error(validate_standard_result(bad_status), "status") - - missing_error_message <- valid - missing_error_message$status <- "error" - expect_error(validate_standard_result(missing_error_message), "error_message") - - unexpected_error_message <- valid - unexpected_error_message$error_message <- "boom" - expect_error(validate_standard_result(unexpected_error_message), "error_message") - - bad_error_message_type <- valid - bad_error_message_type$status <- "error" - bad_error_message_type$error_message <- 1 - expect_error(validate_standard_result(bad_error_message_type), "error_message") -}) - -test_that("print.pecan_preprocess_result outputs expected format for populated result", { - r <- standard_result(tag = "met", source = "ERA5", paths = "/tmp/test.nc") - - output <- capture.output(print(r)) - - expect_match(output[1], "PEcAn preprocessing result \\[met\\]") - expect_match(output[2], "status: success") - expect_match(output[3], "source: ERA5") - expect_match(output[5], "paths: /tmp/test.nc") -}) - -test_that("print.pecan_preprocess_result handles empty paths and errors", { - skipped <- standard_result(tag = "soil", status = "skipped") - skipped_output <- capture.output(print(skipped)) - expect_match(skipped_output[5], "paths: ") - - errored <- standard_result( - tag = "met", - status = "error", - error_message = "download failed" - ) - error_output <- capture.output(print(errored)) - expect_true(any(grepl("error: download failed", error_output))) -}) - -test_that("as.data.frame.pecan_preprocess_result expands one row per path", { - r <- standard_result( - tag = "met", - paths = c("/tmp/a.nc", "/tmp/b.nc"), - input_id = 1L, - source = "ERA5" - ) - - df <- as.data.frame(r) - expect_equal(nrow(df), 2) - expect_equal(df$tag, c("met", "met")) - expect_equal(df$path, c("/tmp/a.nc", "/tmp/b.nc")) - expect_equal(df$input_id, c(1L, 1L)) - expect_equal(df$error_message, c(NA_character_, NA_character_)) -}) - -test_that("as.data.frame.pecan_preprocess_result handles empty paths", { - r <- standard_result(tag = "soil") - - df <- as.data.frame(r) - expect_equal(nrow(df), 1) - expect_equal(df$tag, "soil") - expect_true(is.na(df$path)) - expect_true(is.na(df$error_message)) -}) - -test_that("standard_result serialization preserves the contract", { - r <- standard_result( - tag = "met", - paths = c("/tmp/a.nc", "/tmp/b.nc"), - input_id = 10L, - dbfile_id = 20L, - format = "CF Meteorology", - source = "ERA5", - status = "success" - ) - - restored <- unserialize(serialize(r, NULL)) - - expect_s3_class(restored, "pecan_preprocess_result") - expect_identical(restored, r) - expect_identical(validate_standard_result(restored), restored) -}) - -test_that("backward compatibility supports legacy-shaped classed lists", { - legacy <- list( - tag = "met", - paths = "/tmp/test.nc", - input_id = 1L, - dbfile_id = NA_integer_, - format = "CF Meteorology", - source = "ERA5", - status = "success", - error_message = NULL - ) - class(legacy) <- c("pecan_preprocess_result", "list") - - expect_identical(validate_standard_result(legacy), legacy) - expect_equal(as.data.frame(legacy)$path, "/tmp/test.nc") -}) - -test_that("invalid constructor values fail fast", { - expect_error(standard_result(tag = "met", status = "error"), "error_message") - expect_error(standard_result(tag = "met", status = "success", error_message = "boom"), "error_message") - expect_error(standard_result(tag = "met", status = "unknown"), "status") -}) \ No newline at end of file