diff --git a/R/sysdata.rda b/R/sysdata.rda index a03d63cc..939e70f6 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/utils_insert_db.R b/R/utils_insert_db.R index 2fecbaf9..231c2850 100644 --- a/R/utils_insert_db.R +++ b/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) diff --git a/data-raw/internal-data.R b/data-raw/internal-data.R index b83d861d..51bb02ce 100644 --- a/data-raw/internal-data.R +++ b/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) diff --git a/inst/db-config.yml b/inst/db-config.yml index 923d14ea..44924d65 100644 --- a/inst/db-config.yml +++ b/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