Enable pulling from pre-stored demo packages

R/utils_insert_db.R

@@ -63,6 +63,9 @@ insert_pkg_info_to_db <- function(pkg_name, pkg_version,
       # pkg_name <- "dplyr" # testing
       if (isTRUE(getOption("shiny.testmode")))
         pkg_info <- test_pkg_info[[pkg_name]]
+      else if (identical(Sys.getenv("GOLEM_CONFIG_ACTIVE"), "demo") && 
+               (pkg_name %in% demo_pkg_lst))
+        pkg_info <- demo_pkg_info[[pkg_name]]
       else if (identical(Sys.getenv("TESTTHAT"), "true"))
         pkg_info <- get_latest_pkg_info(pkg_name)
       else
@@ -154,7 +157,11 @@ upload_package_to_db <- function(name, version, title, description,
 insert_riskmetric_to_db <- function(pkg_name, pkg_version = "",
     db_name = golem::get_golem_options('assessment_db_name')){
 
-  if (!isTRUE(getOption("shiny.testmode"))) {
+  if (identical(Sys.getenv("GOLEM_CONFIG_ACTIVE"), "demo") && 
+      (pkg_name %in% demo_pkg_lst)) {
+    riskmetric_assess <-
+      demo_pkg_assess[[pkg_name]]
+  } else if (!isTRUE(getOption("shiny.testmode"))) {
     riskmetric_assess <-
       riskmetric::pkg_ref(pkg_name,
                           source = "pkg_cran_remote") %>%
@@ -296,7 +303,10 @@ insert_riskmetric_to_db <- function(pkg_name, pkg_version = "",
 insert_community_metrics_to_db <- function(pkg_name, 
                                            db_name = golem::get_golem_options('assessment_db_name')) {
 
-  if (!isTRUE(getOption("shiny.testmode")))
+  if (identical(Sys.getenv("GOLEM_CONFIG_ACTIVE"), "demo") && 
+      (pkg_name %in% demo_pkg_lst))
+    pkgs_cum_metrics <- demo_pkg_cum[[pkg_name]]
+  else if (!isTRUE(getOption("shiny.testmode")))
     pkgs_cum_metrics <- generate_comm_data(pkg_name)
   else
     pkgs_cum_metrics <- test_pkg_cum[[pkg_name]]
@@ -394,7 +404,10 @@ upload_pkg_lst <- function(pkg_lst, assess_db, repos, repo_pkgs, user_name = "sy
       updateProgress(1, glue::glue("{uploaded_packages$package[i]}"))
 
     if (grepl("^[[:alpha:]][[:alnum:].]*[[:alnum:]]$", uploaded_packages$package[i])) {
-      if (!isTRUE(getOption("shiny.testmode")))
+      if (identical(Sys.getenv("GOLEM_CONFIG_ACTIVE"), "demo") && 
+          (uploaded_packages$package[i] %in% demo_pkg_lst))
+        ref <- demo_pkg_refs[[uploaded_packages$package[i]]]
+      else if (!isTRUE(getOption("shiny.testmode")))
         ref <- riskmetric::pkg_ref(uploaded_packages$package[i],
                                    source = "pkg_cran_remote")
       else
@@ -449,7 +462,8 @@ upload_pkg_lst <- function(pkg_lst, assess_db, repos, repo_pkgs, user_name = "sy
       if (is.function(updateProgress))
         updateProgress(1)
 
-      if (!isTRUE(getOption("shiny.testmode"))) {
+      if (!isTRUE(getOption("shiny.testmode")) && 
+          (!identical(Sys.getenv("GOLEM_CONFIG_ACTIVE"), "demo") || !ref$name %in% demo_pkg_lst)) {
         dwn_ld <- try(utils::download.file(ref$tarball_url, file.path("tarballs", basename(ref$tarball_url)), 
                                            quiet = TRUE, mode = "wb"),
                       silent = TRUE)

data-raw/internal-data.R

@@ -57,6 +57,16 @@ template <- read.csv(file.path('data-raw', 'upload_format.csv'),  stringsAsFacto
 
 test_pkg_lst <- c("dplyr", "tidyr", "readr", "purrr", "tibble", "stringr", "forcats")
 
+demo_package_tbl <- 
+  RSQLite::SQLite() |> 
+  DBI::dbConnect("demo_database.sqlite") |> 
+  dplyr::tbl("package")
+
+demo_pkg_lst <- 
+  demo_package_tbl |> 
+  dplyr::pull(name) |> 
+  sort()
+
 library(magrittr)
 test_pkg_refs_compl <-
   test_pkg_lst %>%
@@ -67,23 +77,49 @@ test_pkg_refs <-
   test_pkg_refs_compl %>%
   purrr::map(~ .x[c("name", "version", "source")] %>% purrr::set_names(c("name", "version", "source")))
 
+demo_pkg_refs <- 
+  demo_pkg_lst |> 
+  purrr::map(\(x) demo_package_tbl |> 
+               dplyr::filter(name == x) |> 
+               dplyr::mutate(source = "pkg_cran_remote") |> 
+               dplyr::select(name, version, source) |> 
+               as.data.frame() |> 
+               as.list()) |> 
+  purrr::set_names(demo_pkg_lst)
+
 devtools::load_all()
 test_pkg_info <-
   test_pkg_lst %>%
   purrr::map(get_latest_pkg_info) %>%
   purrr::set_names(test_pkg_lst)
 
+demo_pkg_info <-
+  demo_pkg_lst |> 
+  purrr::map(\(x) get_pkg_info(x, "demo_database.sqlite") |> 
+               dplyr::select(Version=version, Maintainer=maintainer, Author=author, License=license, Published=published_on, Title=title, Description=description)) |> 
+  purrr::set_names(demo_pkg_lst)
+
 test_pkg_assess <-
   test_pkg_refs_compl %>%
   purrr::map( ~ .x %>%
                 dplyr::as_tibble() %>%
                 riskmetric::pkg_assess())
 
+demo_pkg_assess <-
+  demo_pkg_lst |> 
+  purrr::map(\(x) get_assess_blob(x, "demo_database.sqlite")) |> 
+  purrr::set_names(demo_pkg_lst)
+
 test_pkg_cum <-
   test_pkg_lst %>%
   purrr::map(generate_comm_data) %>%
   purrr::set_names(test_pkg_lst)
 
+demo_pkg_cum <-
+  demo_pkg_lst |> 
+  purrr::map(\(x) get_comm_data(x, "demo_database.sqlite")) |> 
+  purrr::set_names(demo_pkg_lst)
+
 # New light palette, verified as color-blind friendly here:
 # https://davidmathlogic.com/colorblind/#%239CFF94-%23B3FF87-%23BCFF43-%23D8F244-%23F2E24B-%23FFD070-%23FFBE82-%23FFA87C-%23FF8F6C-%23FF765B
 # code:
@@ -154,5 +190,6 @@ usethis::use_data(
   test_pkg_lst, test_pkg_refs, test_pkg_info, test_pkg_assess, test_pkg_cum,
   color_palette, used_privileges, metric_lst, rpt_choices,
   team_info_df,
+  demo_pkg_lst, demo_pkg_refs, demo_pkg_info, demo_pkg_assess, demo_pkg_cum,
   internal = TRUE, overwrite = TRUE)
 

inst/db-config.yml

@@ -75,6 +75,7 @@ example2:
       - GxP Compliant
       - Needs Review
       - Not GxP Compliant
+      - Something
 noncredentialed:
   use_shinymanager: false
   assessment_db: database_noncredentialed.sqlite
@@ -83,3 +84,13 @@ noncredentialed:
       - default
     privileges:
       default: [admin, weight_adjust, auto_decision_adjust, final_decision, revert_decision, add_package, delete_package, overall_comment, general_comment]
+demo_database:
+  assessment_db: demo_database.sqlite
+  decisions:
+    categories:
+      - Approved
+      - Low Risk
+      - Needs Review
+      - High Risk
+demo:
+  inherits: demo_database