Merge pull request #179 from CHOP-CGTInformatics/supertibble-style

Fix supertibble label

DESCRIPTION

@@ -31,7 +31,9 @@ Imports:
     tibble,
     tidyr,
     tidyselect,
-    formattable
+    formattable,
+    pillar,
+    vctrs
 Suggests: 
     covr,
     knitr,
@@ -49,5 +51,5 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(tbl_sum,redcap_supertbl)
+S3method(vec_ptype_abbr,redcap_supertbl)
 export(add_skimr_metadata)
 export(bind_tibbles)
 export(extract_tibble)
@@ -56,6 +58,7 @@ importFrom(formattable,percent)
 importFrom(lobstr,obj_size)
 importFrom(lubridate,is.difftime)
 importFrom(lubridate,is.period)
+importFrom(pillar,tbl_sum)
 importFrom(purrr,compose)
 importFrom(purrr,map)
 importFrom(purrr,map2)
@@ -114,3 +117,4 @@ importFrom(tidyselect,eval_select)
 importFrom(tidyselect,everything)
 importFrom(tidyselect,starts_with)
 importFrom(tidyselect,where)
+importFrom(vctrs,vec_ptype_abbr)

R/REDCapTidieR-package.R

@@ -23,6 +23,8 @@
 #' @importFrom tidyr complete fill pivot_wider nest unnest unnest_wider
 #' @importFrom tidyselect all_of any_of ends_with eval_select everything
 #' starts_with where
+#' @importFrom vctrs vec_ptype_abbr
+#' @importFrom pillar tbl_sum
 "_PACKAGE"
 
 ## usethis namespace: start

R/clean_redcap_long.R

@@ -85,7 +85,7 @@ clean_redcap_long <- function(db_data_long,
       # Retrieve mixed structure fields and forms in reference df
       mixed_structure_ref <- get_mixed_structure_fields(db_data_long) %>%
         filter(.data$rep_and_nonrep & !str_ends(.data$field_name, "_form_complete")) %>%
-        left_join(db_metadata_long %>% select(.data$field_name, .data$form_name),
+        left_join(db_metadata_long %>% select("field_name", "form_name"),
           by = "field_name"
         )
 

R/read_redcap.R

@@ -489,18 +489,3 @@ calc_metadata_stats <- function(data) {
     data_na_pct = percent(na_pct, digits = 2, format = "fg")
   )
 }
-
-#' @title
-#' Add supertbl S3 class
-#'
-#' @param x an object to class
-#'
-#' @return
-#' The object with `redcaptidier_supertbl` S3 class
-#'
-#' @keywords internal
-#'
-as_supertbl <- function(x) {
-  class(x) <- c("redcap_supertbl", class(x))
-  x
-}

R/supertibble.R

@@ -0,0 +1,26 @@
+#' @title
+#' Add supertbl S3 class
+#'
+#' @param x an object to class
+#'
+#' @return
+#' The object with `redcaptidier_supertbl` S3 class
+#'
+#' @keywords internal
+#'
+as_supertbl <- function(x) {
+  class(x) <- c("redcap_supertbl", class(x))
+  x
+}
+
+#' @inherit vctrs::vec_ptype_abbr params return title description
+#' @export
+vec_ptype_abbr.redcap_supertbl <- function(x, ..., prefix_named, suffix_shape) {
+  "suprtbl"
+}
+
+#' @inherit pillar::tbl_sum params return title description
+#' @export
+tbl_sum.redcap_supertbl <- function(x) {
+  paste("A REDCapTidieR Supertibble with", nrow(x), "instruments")
+}

pkgdown/_pkgdown.yml

@@ -67,3 +67,7 @@ reference:
 - title: "Data"
   contents:
   - superheroes_supertbl
+- title: "S3 methods"
+  contents:
+  - tbl_sum.redcap_supertbl
+  - vec_ptype_abbr.redcap_supertbl

renv.lock

@@ -1436,13 +1436,8 @@
     },
     "renv": {
       "Package": "renv",
-      "Version": "1.0.3",
-      "Source": "Repository",
-      "Repository": "CRAN",
-      "Requirements": [
-        "utils"
-      ],
-      "Hash": "41b847654f567341725473431dd0d5ab"
+      "Version": "1.0.5",
+      "Source": "Repository"
     },
     "repr": {
       "Package": "repr",
@@ -1460,6 +1455,28 @@
       ],
       "Hash": "fab761ee8f3554a04afef40ac53689f4"
     },
+    "reprex": {
+      "Package": "reprex",
+      "Version": "2.1.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R",
+        "callr",
+        "cli",
+        "clipr",
+        "fs",
+        "glue",
+        "knitr",
+        "lifecycle",
+        "rlang",
+        "rmarkdown",
+        "rstudioapi",
+        "utils",
+        "withr"
+      ],
+      "Hash": "1425f91b4d5d9a8f25352c44a3d914ed"
+    },
     "revdepcheck": {
       "Package": "revdepcheck",
       "Version": "1.0.0.9001",

renv/activate.R

@@ -2,7 +2,7 @@
 local({
 
   # the requested version of renv
-  version <- "1.0.3"
+  version <- "1.0.5"
   attr(version, "sha") <- NULL
 
   # the project directory
@@ -31,6 +31,14 @@ local({
     if (!is.null(override))
       return(override)
 
+    # if we're being run in a context where R_LIBS is already set,
+    # don't load -- presumably we're being run as a sub-process and
+    # the parent process has already set up library paths for us
+    rcmd <- Sys.getenv("R_CMD", unset = NA)
+    rlibs <- Sys.getenv("R_LIBS", unset = NA)
+    if (!is.na(rlibs) && !is.na(rcmd))
+      return(FALSE)
+
     # next, check environment variables
     # TODO: prefer using the configuration one in the future
     envvars <- c(
@@ -50,9 +58,22 @@ local({
 
   })
 
-  if (!enabled)
+  # bail if we're not enabled
+  if (!enabled) {
+
+    # if we're not enabled, we might still need to manually load
+    # the user profile here
+    profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
+    if (file.exists(profile)) {
+      cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE")
+      if (tolower(cfg) %in% c("true", "t", "1"))
+        sys.source(profile, envir = globalenv())
+    }
+
     return(FALSE)
 
+  }
+
   # avoid recursion
   if (identical(getOption("renv.autoloader.running"), TRUE)) {
     warning("ignoring recursive attempt to run renv autoloader")
@@ -1041,7 +1062,7 @@ local({
     # if jsonlite is loaded, use that instead
     if ("jsonlite" %in% loadedNamespaces()) {
 
-      json <- catch(renv_json_read_jsonlite(file, text))
+      json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity)
       if (!inherits(json, "error"))
         return(json)
 
@@ -1050,7 +1071,7 @@ local({
     }
 
     # otherwise, fall back to the default JSON reader
-    json <- catch(renv_json_read_default(file, text))
+    json <- tryCatch(renv_json_read_default(file, text), error = identity)
     if (!inherits(json, "error"))
       return(json)
 
@@ -1063,14 +1084,14 @@ local({
   }
 
   renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
   }
 
   renv_json_read_default <- function(file = NULL, text = NULL) {
 
     # find strings in the JSON
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
     locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
 
@@ -1118,14 +1139,14 @@ local({
     map <- as.list(map)
 
     # remap strings in object
-    remapped <- renv_json_remap(json, map)
+    remapped <- renv_json_read_remap(json, map)
 
     # evaluate
     eval(remapped, envir = baseenv())
 
   }
 
-  renv_json_remap <- function(json, map) {
+  renv_json_read_remap <- function(json, map) {
 
     # fix names
     if (!is.null(names(json))) {
@@ -1152,7 +1173,7 @@ local({
     # recurse
     if (is.recursive(json)) {
       for (i in seq_along(json)) {
-        json[i] <- list(renv_json_remap(json[[i]], map))
+        json[i] <- list(renv_json_read_remap(json[[i]], map))
       }
     }
 

tests/testthat/_snaps/supertibble.md

@@ -0,0 +1,14 @@
+# supertibble prints with style
+
+    Code
+      .
+    Output
+      # A REDCapTidieR Supertibble with 5 instruments
+        redcap_form_name redcap_data
+        <chr>            <list>     
+      1 a                <NULL>     
+      2 b                <NULL>     
+      3 c                <NULL>     
+      4 d                <NULL>     
+      5 e                <NULL>     
+