From 4c5d4d690731ad4725b2e8e3db74d8aec950b64b Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 12:31:03 -0500 Subject: [PATCH 1/7] print method for epirange --- R/model.R | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/R/model.R b/R/model.R index 8ba7a2b6..785c7584 100644 --- a/R/model.R +++ b/R/model.R @@ -61,6 +61,31 @@ epirange <- function(from, to) { structure(list(from = from, to = to), class = "EpiRange") } +#' @export +print.EpiRange <- function(x, ...) { + stopifnot(inherits(x, "EpiRange")) + + if (nchar(x$from) == 8) { + date_type <- "Days" + x$from <- as.Date(as.character(x$from), "%Y%m%d") + x$to <- as.Date(as.character(x$to), "%Y%m%d") + } else if (nchar(x$from) == 6) { + date_type <- "Epiweeks" + x$from <- format( + as.Date(as.character(x$from), "%Y%U"), + "%Yw%U" + ) + x$to <- format( + as.Date(as.character(x$to), "%Y%U"), + "%Yw%U" + ) + } + + cli::cli_h1(" object:") + cli::cli_bullets( + "{date_type} from {x$from} to {x$to}" + ) +} #' Timeset formats for specifying dates #' @@ -86,7 +111,6 @@ epirange <- function(from, to) { #' @name timeset NULL - create_epidata_field_info <- function(name, type, description = "", From 1ec140e8af76063d08d8490c8988c0b770c21cef Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 12:56:14 -0500 Subject: [PATCH 2/7] print simple list classes --- R/epidatacall.R | 8 ++++++++ R/model.R | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/R/epidatacall.R b/R/epidatacall.R index 625a377e..a7a17072 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -198,6 +198,14 @@ fetch_args_list <- function( ) } +#' @export +print.fetch_args <- function(x, ...) { + stopifnot(inherits(x, "fetch_args")) + cli::cli_h1(" object:") + # Print all non-class fields. + print(x[attr(x, "names")]) +} + #' Fetches the data #' #' @details diff --git a/R/model.R b/R/model.R index 785c7584..4169ded4 100644 --- a/R/model.R +++ b/R/model.R @@ -141,6 +141,14 @@ create_epidata_field_info <- function(name, ) } +#' @export +print.EpidataFieldInfo <- function(x, ...) { + stopifnot(inherits(x, "EpidataFieldInfo")) + cli::cli_h1(" object:") + # Print all non-class fields. + print(x[attr(x, "names")]) +} + parse_value <- function(info, value, disable_date_parsing = FALSE) { stopifnot(inherits(info, "EpidataFieldInfo")) From 42bda42858217748a52600fd622a4d5e2d6e5124 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 13:14:45 -0500 Subject: [PATCH 3/7] document --- NAMESPACE | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 9b5b245c..d9630348 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,11 +2,14 @@ S3method(as_tibble,covidcast_data_signal_list) S3method(as_tibble,covidcast_data_source_list) +S3method(print,EpiRange) +S3method(print,EpidataFieldInfo) S3method(print,covidcast_data_signal) S3method(print,covidcast_data_signal_list) S3method(print,covidcast_data_source) S3method(print,covidcast_epidata) S3method(print,epidata_call) +S3method(print,fetch_args) export(avail_endpoints) export(cache_info) export(clear_cache) From 093fac05bdf7bbad33681cd6bf3db19f389599ea Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 13:33:51 -0500 Subject: [PATCH 4/7] linting; var used in glue syntax not recognized --- R/model.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/model.R b/R/model.R index 4169ded4..d4885f00 100644 --- a/R/model.R +++ b/R/model.R @@ -66,11 +66,11 @@ print.EpiRange <- function(x, ...) { stopifnot(inherits(x, "EpiRange")) if (nchar(x$from) == 8) { - date_type <- "Days" + date_type <- "Days" # nolint: object_usage_linter x$from <- as.Date(as.character(x$from), "%Y%m%d") x$to <- as.Date(as.character(x$to), "%Y%m%d") } else if (nchar(x$from) == 6) { - date_type <- "Epiweeks" + date_type <- "Epiweeks" # nolint: object_usage_linter x$from <- format( as.Date(as.character(x$from), "%Y%U"), "%Yw%U" From 3255ac4ed37d214c9554acb73f9db2d29efeb082 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 16:26:55 -0500 Subject: [PATCH 5/7] don't check class in class-specific prints --- R/epidatacall.R | 2 -- R/model.R | 3 --- 2 files changed, 5 deletions(-) diff --git a/R/epidatacall.R b/R/epidatacall.R index a7a17072..b9f7d153 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -121,7 +121,6 @@ request_arguments <- function(epidata_call, format_type, fields = NULL) { #' @export print.epidata_call <- function(x, ...) { - stopifnot(inherits(x, "epidata_call")) cli::cli_h1(" object:") cli::cli_bullets(c( "*" = "Pipe this object into `fetch()` to actually fetch the data", @@ -200,7 +199,6 @@ fetch_args_list <- function( #' @export print.fetch_args <- function(x, ...) { - stopifnot(inherits(x, "fetch_args")) cli::cli_h1(" object:") # Print all non-class fields. print(x[attr(x, "names")]) diff --git a/R/model.R b/R/model.R index d4885f00..38923145 100644 --- a/R/model.R +++ b/R/model.R @@ -63,8 +63,6 @@ epirange <- function(from, to) { #' @export print.EpiRange <- function(x, ...) { - stopifnot(inherits(x, "EpiRange")) - if (nchar(x$from) == 8) { date_type <- "Days" # nolint: object_usage_linter x$from <- as.Date(as.character(x$from), "%Y%m%d") @@ -143,7 +141,6 @@ create_epidata_field_info <- function(name, #' @export print.EpidataFieldInfo <- function(x, ...) { - stopifnot(inherits(x, "EpidataFieldInfo")) cli::cli_h1(" object:") # Print all non-class fields. print(x[attr(x, "names")]) From c2dd04b1ec02fbec7704438ce02aef24ed504af6 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 16:35:27 -0500 Subject: [PATCH 6/7] avoid date conversion for epiweek epiranges --- R/model.R | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/model.R b/R/model.R index 38923145..d3a18b41 100644 --- a/R/model.R +++ b/R/model.R @@ -69,13 +69,11 @@ print.EpiRange <- function(x, ...) { x$to <- as.Date(as.character(x$to), "%Y%m%d") } else if (nchar(x$from) == 6) { date_type <- "Epiweeks" # nolint: object_usage_linter - x$from <- format( - as.Date(as.character(x$from), "%Y%U"), - "%Yw%U" + x$from <- paste0( + substr(x$from, 1, 4), "w", substr(x$from, 5, 6) ) - x$to <- format( - as.Date(as.character(x$to), "%Y%U"), - "%Yw%U" + x$to <- paste0( + substr(x$to, 1, 4), "w", substr(x$to, 5, 6) ) } From 1b2f1bb6a92ea672cf9955b00f228b72b5bd0a7f Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Thu, 4 Jan 2024 16:49:02 -0500 Subject: [PATCH 7/7] use cli_dl to avoid mixing cli and `print` in class-print fns --- R/epidatacall.R | 2 +- R/model.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/epidatacall.R b/R/epidatacall.R index b9f7d153..cde20c9b 100644 --- a/R/epidatacall.R +++ b/R/epidatacall.R @@ -201,7 +201,7 @@ fetch_args_list <- function( print.fetch_args <- function(x, ...) { cli::cli_h1(" object:") # Print all non-class fields. - print(x[attr(x, "names")]) + cli::cli_dl(x[attr(x, "names")]) } #' Fetches the data diff --git a/R/model.R b/R/model.R index d3a18b41..a14f8960 100644 --- a/R/model.R +++ b/R/model.R @@ -141,7 +141,7 @@ create_epidata_field_info <- function(name, print.EpidataFieldInfo <- function(x, ...) { cli::cli_h1(" object:") # Print all non-class fields. - print(x[attr(x, "names")]) + cli::cli_dl(x[attr(x, "names")]) } parse_value <- function(info, value, disable_date_parsing = FALSE) {