fix: preserve legacy pipeline and history contracts

R/alert_functions.R

@@ -253,15 +253,15 @@
 #'@param completetail if sinan data is older than final_day, fill in the tail with NA (default) or 0.
 #'@param dataini "notif" (default) or "sinpri"
 #'@param writedb TRUE if it should write into the database, default is FALSE.
-#'@param datasource posgreSQL connection to project's database
+#'@param datasource Database connection; defaults to the legacy global `con`.
 #'@param workers Positive number of workers. Defaults to portable serial execution.
 #'@param seed Optional seed for stochastic nowcasting.
 #'@param verbose Whether to emit progress messages.
 #'@param version_date Explicit model-version date used when writing results.
 #'@param firstday First date of the notification series passed to fetch_cases().
 #' Defaults to 2018-01-01; supply an earlier date for historical backfills.
-#'@return data.frame with the week condition and the number of weeks within the
-#'last lag weeks with conditions = TRUE.
+#'@return A named list of municipal `alerta` objects, preserving the legacy
+#'   result structure.
 #'@examplesIf FALSE
 #'cidades <- getCidades(uf = "Rio de Janeiro",datasource = connection)
 #'t1 <- Sys.time()
@@ -277,7 +277,7 @@
 
 pipe_infodengue <- function(cities, cid10="A90", datarelatorio, finalday = NULL,
                             iniSE = 201001, nowcasting="none", narule=NULL,
-                            writedb = FALSE, datasource, completetail = NA,
+                            writedb = FALSE, datasource = con, completetail = NA,
                             dataini = "notific", workers = 1L, seed = NULL,
                             verbose = FALSE, version_date = finalday,
                             firstday = as.Date("2018-01-01")){
@@ -344,7 +344,32 @@ pipe_infodengue <- function(cities, cid10="A90", datarelatorio, finalday = NULL,
             write_alert_results(datasource, res, version_date = version_date,
                                 conflict = "update")
       }
-      res
+      .as_legacy_alert_objects(res)
+}
+
+.as_legacy_alert_objects <- function(result) {
+      data <- result$data
+      groups <- split(seq_len(nrow(data)), factor(data$cidade,
+                                                   levels = unique(data$cidade)))
+      legacy <- lapply(names(groups), function(city) {
+            rows <- groups[[city]]
+            parameters <- result$parameters[
+                  result$parameters$municipio_geocodigo == as.numeric(city), , drop = FALSE
+            ]
+            values <- structure(as.character(parameters[1, ]), names = names(parameters))
+            criteria <- define_alert_rules(parameters$codmodelo[[1]], values)
+            alert <- list(
+                  data = data[rows, , drop = FALSE],
+                  indices = result$alerts[rows, , drop = FALSE],
+                  crit = criteria,
+                  n = 4L
+            )
+            class(alert) <- "alerta"
+            alert
+      })
+      names(legacy) <- names(groups)
+      attr(legacy, "parameters") <- result$parameters
+      legacy
 }
 
 
@@ -414,7 +439,7 @@ calc.alerta <- function(x, pars, level = "municipio",...){  #x = cities[i]
 #'@param lastSE last week of the table. Default is the last date in obj.
 #'@param type "notified", if it should return total counts, disregarding the
 #'final classification. For compatibility reasons.
-#'@param versao Explicit model-version date.
+#'@param versao Model-version date; defaults to the current date for legacy calls.
 #'@param parameters Parameter data frame. Pipeline results carry it as an attribute;
 #'direct alert objects must supply it explicitly.
 #'@return data.frame with the data to be written.

R/api.R

@@ -512,13 +512,14 @@ fouralert <- function(obj, crit, miss = "last", dy = 4) {
 #' Legacy history converter
 #' @param obj,iniSE,lastSE,type,versao,parameters Legacy arguments.
 #' @export
-tabela_historico <- function(obj, iniSE, lastSE, type = "all", versao,
+tabela_historico <- function(obj, iniSE, lastSE, type = "all", versao = Sys.Date(),
                              parameters = if (inherits(obj, "alerttools_result")) obj$parameters else attr(obj, "parameters")) {
   .deprecate_api("tabela_historico()", "as_alert_history()")
+  if (missing(versao)) versao <- Sys.Date()
   args <- list(obj = obj, type = type, parameters = parameters)
   if (!missing(iniSE)) args$iniSE <- iniSE
   if (!missing(lastSE)) args$lastSE <- lastSE
-  if (!missing(versao)) args$versao <- versao
+  args$versao <- versao
   do.call(.as_alert_history_impl, args)
 }
 

tests/testthat/test-api.R

@@ -157,6 +157,37 @@ test_that("legacy wrappers warn and preserve argument and result adapters", {
   )
 })
 
+test_that("legacy pipeline and history wrappers preserve their public contracts", {
+  withr::local_options(list(lifecycle_verbosity = "quiet"))
+  expect_identical(formals(pipe_infodengue)$datasource, quote(con))
+  expect_identical(formals(tabela_historico)$versao, quote(Sys.Date()))
+
+  connection <- sqlite_fixture_connection(environment())
+  had_global_con <- exists("con", envir = .GlobalEnv, inherits = FALSE)
+  if (had_global_con) old_global_con <- get("con", envir = .GlobalEnv)
+  assign("con", connection, envir = .GlobalEnv)
+  withr::defer({
+    if (had_global_con) {
+      assign("con", old_global_con, envir = .GlobalEnv)
+    } else if (exists("con", envir = .GlobalEnv, inherits = FALSE)) {
+      rm("con", envir = .GlobalEnv)
+    }
+  })
+  result <- pipe_infodengue(
+    cities = 3304557, cid10 = "A90", datarelatorio = 202106,
+    nowcasting = "none", firstday = as.Date("2020-12-20"), completetail = 0
+  )
+
+  expect_named(result, "3304557")
+  expect_s3_class(result[[1]], "alerta")
+  expect_named(result[[1]], c("data", "indices", "crit", "n"))
+  expect_equal(result[[1]]$data$SE, c(202052, 202053, 202101:202106))
+
+  history <- tabela_historico(result, iniSE = 202052)
+  expect_s3_class(history, "data.frame")
+  expect_equal(nrow(history), 8)
+})
+
 test_that("snake_case computational aliases preserve baseline results", {
   withr::local_options(list(lifecycle_verbosity = "quiet"))
   cases <- read_fixture("cases.csv")

tests/testthat/test-core-pipeline.R

@@ -52,7 +52,7 @@ test_that("alerttools_result methods expose a stable result contract", {
   expect_s3_class(history, "data.frame")
   expect_equal(nrow(history), 8)
   expect_true(all(c("data_iniSE", "municipio_geocodigo", "nivel_inc") %in% names(history)))
-  expect_error(tabela_historico(result), "explicit.*versao")
+  expect_equal(nrow(tabela_historico(result)), 8)
 })
 
 test_that("alerttools_result constructor handles empty and invalid inputs", {

tests/testthat/test-data-repository.R

@@ -194,7 +194,7 @@ test_that("SQL file export quotes literals instead of interpolating user values"
   expect_match(sql, "INSERT INTO \"Municipio\".\"Historico_alerta\"", fixed = TRUE)
 })
 
-test_that("database functions never fall back to a global con object", {
+test_that("database functions require an explicit connection", {
   withr::local_options(list(lifecycle_verbosity = "quiet"))
   connection <- sqlite_fixture_connection(environment())
   assign("con", connection, envir = .GlobalEnv)
@@ -203,7 +203,7 @@ test_that("database functions never fall back to a global con object", {
   database_functions <- list(getCases, getCaseslist, getClima, getWU, getTweet,
                              getCidades, getRegionais, read.parameters,
                              write_parameters, getWUstation, setWUstation,
-                             read.cases, getdelaydata, pipe_infodengue,
+                             read.cases, getdelaydata,
                              write_alerta, applyGenTimeDist)
   expect_true(all(vapply(database_functions, function(fun) {
     identical(formals(fun)$datasource, quote(expr = ))