Merge pull request #504 from yjunechoe/info_columns-dummy-header

Use richer dummy data for resolving columns of a lazy tbl informant

NEWS.md

@@ -2,7 +2,7 @@
 
 ## New features
 
-* Complete `{tidyselect}` support for the `columns` argument of *all validation functions*, as well as in `has_columns()`. `columns` can now takes familiar column-selection expressions as one would use inside `dplyr::select()`. This also begins a process of deprecation:
+* Complete `{tidyselect}` support for the `columns` argument of *all validation functions*, as well as in `has_columns()` and `info_columns`. `columns` can now takes familiar column-selection expressions as one would use inside `dplyr::select()`. This also begins a process of deprecation:
   - `columns = vars(...)` will continue to work, but `c()` now supersedes `vars()`.
   - If passing an *external vector* of column names, it should be wrapped in `all_of()`.
 

R/create_informant.R

@@ -399,6 +399,10 @@ create_informant <- function(
     }
   }
 
+  private <- list(
+    col_ptypes = tbl_info$col_ptypes
+  )
+
   metadata_list <-
     c(
       list(
@@ -409,7 +413,8 @@ create_informant <- function(
           `_type` = table_type
         )
       ),
-      column_list
+      column_list,
+      list(`_private` = private)
     )
 
   # Create the metadata list object

R/get_informant_report.R

@@ -139,6 +139,8 @@ get_informant_report <- function(
     y <- informant$metadata_rev
   } else {
     y <- informant$metadata
+    # Hide private metadata from report
+    y[["_private"]] <- NULL
   }
 
   if ("info_label" %in% names(informant)) {

R/incorporate.R

@@ -371,7 +371,7 @@ incorporate <- function(informant) {
   extra_sections <- 
     base::setdiff(
       names(informant$metadata),
-      c("info_label", "table", "columns")
+      c("info_label", "table", "columns", "_private")
     )
 
   metadata_extra <- informant$metadata[extra_sections]

R/info_add.R

@@ -450,7 +450,7 @@ info_columns <- function(
   metadata_columns <- metadata_list$columns
 
   if (is.null(x$tbl)) {
-    tbl <- dplyr::as_tibble(metadata_columns %>% lapply(function(x) 1))
+    tbl <- metadata_list[["_private"]]$col_ptypes
   } else {
     tbl <- x$tbl
   }

R/utils.R

@@ -758,19 +758,18 @@ get_tbl_dbi_src_details <- function(tbl) {
 get_r_column_names_types <- function(tbl) {
 
   suppressWarnings(
-    column_names_types <-
+    column_header <-
       tbl %>%
       utils::head(1) %>%
-      dplyr::collect() %>%
-      vapply(
-        FUN.VALUE = character(1),
-        FUN = function(x) class(x)[1]
-      )
+      dplyr::collect()
   )
+  column_names_types <-
+    vapply(column_header, function(x) class(x)[1], character(1))
 
   list(
     col_names = names(column_names_types),
-    r_col_types = unname(unlist(column_names_types))
+    r_col_types = unname(unlist(column_names_types)),
+    col_ptypes = utils::head(column_header, 0)
   )
 }
 
@@ -825,7 +824,8 @@ get_tbl_information_df <- function(tbl) {
     db_tbl_name = NA_character_,
     col_names = r_column_names_types$col_names,
     r_col_types = r_column_names_types$r_col_types,
-    db_col_types = NA_character_
+    db_col_types = NA_character_,
+    col_ptypes = r_column_names_types$col_ptypes
   )
 }
 
@@ -849,7 +849,8 @@ get_tbl_information_spark <- function(tbl) {
     db_tbl_name = NA_character_,
     col_names = r_column_names_types$col_names,
     r_col_types = r_column_names_types$r_col_types,
-    db_col_types = db_col_types
+    db_col_types = db_col_types,
+    col_ptypes = r_column_names_types$col_ptypes
   )
 }
 
@@ -1030,7 +1031,8 @@ get_tbl_information_dbi <- function(tbl) {
     db_tbl_name = db_tbl_name,
     col_names = r_column_names_types$col_names,
     r_col_types = r_column_names_types$r_col_types,
-    db_col_types = db_col_types
+    db_col_types = db_col_types,
+    col_ptypes = r_column_names_types$col_ptypes
   )
 }
 
@@ -1074,7 +1076,8 @@ get_tbl_information_arrow <- function(tbl) {
     db_tbl_name = NA_character_,
     col_names = col_names,
     r_col_types = r_col_types,
-    db_col_types = db_col_types
+    db_col_types = db_col_types,
+    col_ptypes = dplyr::collect(utils::head(tbl, 0))
   )
 }
 

R/yaml_write.R

@@ -1612,6 +1612,9 @@ as_informant_yaml_list <- function(informant) {
     lst_locale <- list(locale = informant$locale)
   }
 
+  # Hide private field
+  metadata <- informant$metadata[names(informant$metadata) != "_private"]
+
   c(
     type = "informant",           # YAML type: `informant`
     lst_read_fn,                  # table-prep formula (stored in key `tbl`)
@@ -1620,7 +1623,7 @@ as_informant_yaml_list <- function(informant) {
     lst_lang,                     # informant language
     lst_locale,                   # informant locale
     lst_meta_snippets,            # informant metadata snippet statements
-    informant$metadata            # informant metadata entries
+    metadata                      # informant metadata entries
   )
 }
 

tests/testthat/test-get_informant_report.R

@@ -309,3 +309,54 @@ test_that("The correct title is rendered in the informant report", {
   #   )
   # )
 })
+
+test_that("tidyselect integration in info_columns()", {
+  informant <- create_informant(small_table)
+  informant_lazy <- create_informant(~ small_table)
+
+  # Column headers stored in `$_private`
+  expect_s3_class(informant$metadata[["_private"]]$col_ptypes, "data.frame")
+  expect_s3_class(informant_lazy$metadata[["_private"]]$col_ptypes, "data.frame")
+
+  cols_with_info <- function(x) {
+    cols_info <- sapply(x$metadata$columns, `[[`, "info")
+    names(which(lengths(cols_info) > 0))
+  }
+  is_timepoint <- function(x) {
+    inherits(x, c("POSIXt", "POSIXct", "POSIXlt", "Date"))
+  }
+
+  # String-based and class-based matches both work
+  expect_identical({
+    informant %>% 
+      info_columns(
+        columns = starts_with("date"),
+        info = "Time information"
+      ) %>% 
+      cols_with_info()
+  }, {
+    informant %>% 
+      info_columns(
+        columns = where(is_timepoint),
+        info = "Time information"
+      ) %>% 
+      cols_with_info()
+  })
+  # String-based and class-based matches both work
+  expect_identical({
+    informant_lazy %>% 
+      info_columns(
+        columns = starts_with("date"),
+        info = "Time information"
+      ) %>% 
+      cols_with_info()
+  }, {
+    informant_lazy %>% 
+      info_columns(
+        columns = where(is_timepoint),
+        info = "Time information"
+      ) %>% 
+      cols_with_info()
+  })
+
+})

tests/testthat/test-has_columns.R

@@ -1,3 +1,5 @@
+z <- rlang::missing_arg()
+
 test_that("the `has_columns()` function works when used directly with data", {
 
   # Expect TRUE when *all* of the given column names is present

tests/testthat/test-incorporate_with_informant.R

@@ -56,7 +56,7 @@ test_that("Incorporating an informant yields the correct results", {
   # `informant$metadata_rev`
   expect_equal(
     names(informant_inc$metadata),
-    c("table", "columns", "rows")
+    c("table", "columns", "_private", "rows")
   )
   expect_equal(
     names(informant_inc$metadata_rev),

tests/testthat/test-tidyselect_integration.R

@@ -2,6 +2,7 @@ tbl <- data.frame(x = 1:2, y = 1:2, nonunique = "A")
 exist_col <- "y"
 nonunique_col <- "nonunique"
 nonexist_col <- "z"
+z <- rlang::missing_arg()
 
 test_that("Backwards compatibility with `vars()`", {
 

tests/testthat/test-yaml_read_informant.R

@@ -35,7 +35,6 @@ test_that("Reading an informant from YAML is possible", {
       section_name = "rows",
       row_count = "There are {row_count} rows available."
     )
-
   yaml_write(informant, filename = "informant-test_table.yml")
 
   informant_from_yaml <- yaml_read_informant(filename = "informant-test_table.yml")
@@ -60,6 +59,8 @@ test_that("Reading an informant from YAML is possible", {
   # Expect that the informant (which never had `incorporate()`
   # run on it) is equivalent to the informant object created
   # via `yaml_read_informant()` (i.e., reading in the YAML file)
+  # - *Except* private fields which are note written
+  informant$metadata$`_private` <- NULL
   expect_equivalent(informant, informant_from_yaml)
 
   # Use `incorporate()` on the informant; this creates the list