created get-metadata function

Author: realbp

NAMESPACE

@@ -39,5 +39,6 @@ importFrom(rlang,sym)
 importFrom(stats,setNames)
 importFrom(stringr,str_pad)
 importFrom(stringr,str_trim)
+importFrom(tibble,as_tibble)
 importFrom(utils,data)
 importFrom(utils,read.csv)

R/demo-crowding.R

@@ -70,7 +70,7 @@ demo_crowding <- function(area, areatype, crowding, race) {
     req_perform()
 
   resp <- process_resp(resp, "demographics")
-
+  
   resp$data <- resp$data %>%
     setNames(c(
       get_area(areatype),

R/demo-education.R

@@ -44,8 +44,7 @@
 #'   areatype = "state",
 #'   education = "at least bachelors degree",
 #'   sex = "both sexes",
-#'   race = "all races (includes hispanic)",
-#'   include_metadata = TRUE
+#'   race = "all races (includes hispanic)"
 #' )
 #'
 #' demo_education(
@@ -54,7 +53,7 @@
 #'   education = "less than 9th grade"
 #' )
 #' }
-demo_education <- function(area, areatype, education, sex = NULL, race = NULL, include_metadata=FALSE) {
+demo_education <- function(area, areatype, education, sex = NULL, race = NULL) {
   req <- create_request("demographics")
 
   if (education == "less than 9th grade" && (!is.null(race) || !is.null(sex))) {
@@ -90,28 +89,17 @@ demo_education <- function(area, areatype, education, sex = NULL, race = NULL, i
   resp <- resp %>%
     req_perform()
 
-  resp <- process_resp(resp, "demographics", include_metadata)
+  resp <- process_resp(resp, "demographics")
 
-  if (include_metadata == TRUE) {
-    resp$data <- resp$data %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-    
-    result_df <- process_metadata(resp)
-    
-  } else {
-    resp %>%
-      setNames(c(
-        get_area(areatype),
-        "Percent",
-        "Households",
-        "Rank"
-      )) %>%
-      mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
-  }
+  resp$data <- resp$data %>%
+    setNames(c(
+      get_area(areatype),
+      "Percent",
+      "Households",
+      "Rank"
+    )) %>%
+    mutate(across(c("Percent", "Households"), \(x) as.numeric(x)))
+  
+  process_metadata(resp)
+
 }

R/parse_metadata.R renamed to R/get-metadata.R

@@ -1,25 +1,33 @@
 
+# result <- demo_crowding(
+#   area = "WA",
+#   areatype = "county",
+#   crowding = "household with >1 person per room",
+#   race = "All Races (includes Hispanic)"
+# )
+
 #helper function to remove key from values
 extract_values <- function(key, resp_metadata) {
   values <- resp_metadata[grep(key, resp_metadata)]
   values <- gsub(paste0("^\\s*", key, ":?\\s*"), "", values)
   return(values)
 }
 
-parse_metadata <- function(resp) {
-  resp_metadata <- resp$metadata
+
+get_metadata <- function(input_tbl) {
+  resp_metadata <- attr(input_tbl, "metadata")
 
   resp_metadata <- gsub("\\\"", "", resp_metadata)
-  
+
   report_header <- resp_metadata[1]
   data_report <- c(resp_metadata[2], resp_metadata[3], resp_metadata[4])
   sortedby <- extract_values("Sorted by", resp_metadata)
   createdby <- extract_values("Created by", resp_metadata)
   data_sources <- extract_values("Source", resp_metadata)
   data_dictionary <- extract_values("For more information about", resp_metadata)
   data_limitations <- extract_values("Data for", resp_metadata)
-  
-  
+
+
   demo_metadata_list <- list(
     report_header = report_header,
     data_report = data_report,

R/process-metadata.R

@@ -0,0 +1,42 @@
+#' Custom print function
+#'
+#' This custom print function processes the
+#' metadata output for a response object
+#'
+#' @param x
+#'
+#' @export
+print.cancerprof_tbl <- function(x, ...) {
+  #cat("Metadata:", "\n")
+  # we actually need to figure out how to use pillar here
+  cat("\033[38;5;246m# Access metadata with `get_metadata()`\033[39m", "\n")
+  # for (i in seq_along(attr(x, "metadata"))) {
+  #   cat(names(attr(x, "metadata"))[i], attr(x, "metadata")[[i]], "\n")
+  # }
+  NextMethod(x, ...)
+}
+
+#' Process Metadata
+#'
+#' This function sets the class of the response data 
+#' to use the custom print function
+#'
+#' @param resp A response object
+#' 
+#' @returns A response object with Metadata and a tibble
+#' 
+#' @examples
+#' \dontrun{
+#' process_metadata(resp)
+#' }
+process_metadata <- function(resp) {
+  
+  resp_data <- resp$data
+  resp_metadata <- resp$metadata
+  
+  class(resp_data) <- c("cancerprof_tbl", class(resp_data))
+  attr(resp_data, "metadata") <- resp_metadata
+  
+  #print(resp_data)
+  return(resp_data)
+}