From a71a36c919f3332a94ee678ade5ea441a2c8abda Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Mon, 16 Dec 2024 09:48:21 -0600 Subject: [PATCH] Detect package requirements for plugins. (#337) * Detect package requirements for plugins. Right now this is fairly manual. I'm working toward automating it more. We'll make the user tell us SOME things, but I'm trying to make it a light lift. Closes #322. * See if rsconnect picks up ggplot2 and safetyCharts automatically. * Another attempt to poke renv to see packages. * Quick test of dependency-library-er for shiny deployment. * Load packages on plugin read. * Function for shinyapps workflow. * Handle metrics with 0 flags. If a site doesn't have any flags, display a placeholder GT table. This isn't perfect but it's an easy, stop-gap fix. To test, update app.R, adding this filter to dfResults: `dfResults = dplyr::filter(gsm.app::sample_dfResults, GroupID != "0X159")`. * Document and export plugin dependency functions. * Document and test Plugin dependency functions and other uncovered pieces. * More documentation. * Plugins vignette. * Work around testthat 3.2.2 bug (https://github.com/r-lib/testthat/issues/2037). * Use standardized function converter. Mostly. * Explicitly point to release file for gsm. * Try to make it find gsm 2.2.0. * Revert to normal gsm & wait. * Try a specific commit. * Revert to tag. This is what I want long-term. Let's use this one and see if we can make it work eventually. * One more try to pass the time. * Give shinyapps a GITHUB_PAT. We might have to supply a "real" PAT (with permissions to read other repos), at least until shinyapps fixes their bug (and it wouldn't hurt to have it in place to protect against future bugs). * Update shinyapps-deploy.yaml * Simplify shinyapps workflow. In theory it should finally work without the gt/gsm hacks. --- .github/workflows/shinyapps-deploy.yaml | 16 +-- .gitignore | 1 + DESCRIPTION | 11 +- NAMESPACE | 9 +- R/aaa-shared.R | 8 +- R/gsm.app-package.R | 7 -- R/mod_MetricTable_Server.R | 9 +- R/mod_Plugins_Server.R | 2 +- R/mod_Plugins_UI.R | 4 +- R/plugin_Read.R | 101 ++++++++++++++- R/utils-AsFunction.R | 21 ++++ R/utils-validate.R | 8 +- R/utils-wrangle.R | 2 +- app.R | 7 +- inst/plugins/AE/AE.yml | 4 + man/mod_Plugins_UI.Rd | 4 + man/plugin_GetDependencySources.Rd | 32 +++++ man/plugin_InstallDependencySources.Rd | 22 ++++ man/plugin_LoadDependencies.Rd | 27 ++++ man/plugin_Read.Rd | 1 + man/plugin_ValidateDefinition.Rd | 25 ++++ man/shared-params.Rd | 9 +- man/util_AsFunction.Rd | 22 ++++ .../testthat/_snaps/mod_MetricTable_Server.md | 7 ++ .../plugins/package_extra_field/def.yml | 15 +++ .../plugins/package_missing_name/def.yml | 13 ++ .../fixtures/plugins/package_ok/def.yml | 14 +++ tests/testthat/helper-testServer.R | 3 + tests/testthat/test-data_Validate.R | 45 ++++--- tests/testthat/test-mod_MetricTable_Server.R | 33 +++++ tests/testthat/test-mod_Plugins_UI.R | 6 + tests/testthat/test-plugin_Read.R | 53 ++++++++ tests/testthat/test-utils-AsFunction.R | 23 ++++ tests/testthat/test-utils-validate.R | 7 ++ vignettes/.gitignore | 2 + vignettes/plugins.Rmd | 116 ++++++++++++++++++ 36 files changed, 631 insertions(+), 58 deletions(-) create mode 100644 R/utils-AsFunction.R create mode 100644 man/plugin_GetDependencySources.Rd create mode 100644 man/plugin_InstallDependencySources.Rd create mode 100644 man/plugin_LoadDependencies.Rd create mode 100644 man/plugin_ValidateDefinition.Rd create mode 100644 man/util_AsFunction.Rd create mode 100644 tests/testthat/fixtures/plugins/package_extra_field/def.yml create mode 100644 tests/testthat/fixtures/plugins/package_missing_name/def.yml create mode 100644 tests/testthat/fixtures/plugins/package_ok/def.yml create mode 100644 tests/testthat/test-utils-AsFunction.R create mode 100644 tests/testthat/test-utils-validate.R create mode 100644 vignettes/.gitignore create mode 100644 vignettes/plugins.Rmd diff --git a/.github/workflows/shinyapps-deploy.yaml b/.github/workflows/shinyapps-deploy.yaml index 908fe969..fb4fada3 100644 --- a/.github/workflows/shinyapps-deploy.yaml +++ b/.github/workflows/shinyapps-deploy.yaml @@ -82,14 +82,15 @@ jobs: ) remove.packages(intersect(extras, rownames(installed.packages()))) pak::pak(extras) - # Temporarily force-install gt & safetyCharts from DESCRIPTION source. - if ("gt" %in% rownames(installed.packages())) { - remove.packages("gt") - } - if ("safetyCharts" %in% rownames(installed.packages())) { - remove.packages("safetyCharts") - } + # Make sure everything is up-to-date. pak::pak() + + # Install plugin dependencies. + pkgload::load_all(".", helpers = FALSE, attach_testthat = FALSE) + aePlugin <- plugin_Read(system.file("plugins", "AE", package = "gsm.app")) + plugin_InstallDependencySources(aePlugin) + + # Manually install rsconnect to deploy. pak::pak("rsconnect") shell: Rscript {0} @@ -120,6 +121,7 @@ jobs: run: | echo "GSMAPP_FAVICON=$FAVICON" >> .Renviron echo "GSMAPP_FAVICONCOLOR=$FAVICONCOLOR" >> .Renviron + echo "GITHUB_PAT=$GITHUB_PAT" >> .Renviron - name: Push to shinyapps.io env: diff --git a/.gitignore b/.gitignore index 4e7f1c84..b5c2b087 100644 --- a/.gitignore +++ b/.gitignore @@ -42,3 +42,4 @@ docs rsconnect scratch.R +inst/doc diff --git a/DESCRIPTION b/DESCRIPTION index 3f16cf61..342b332d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,6 @@ Imports: cli, dplyr, favawesome, - ggplot2, glue, gsm (>= 2.1.2), gt (>= 0.11.1.9000), @@ -31,7 +30,6 @@ Imports: magrittr, purrr, rlang, - safetyCharts (>= 0.4.0), shiny (>= 1.6.0), shinycssloaders, shinyjs, @@ -40,18 +38,21 @@ Suggests: chromote (>= 0.3.1), devtools, here, + knitr, + pak, + rmarkdown, shinytest2, stringr, testthat (>= 3.0.0), usethis, withr Remotes: - gsm=Gilead-BioStats/gsm@v2.1.2, - gt=url::https://rstudio.r-universe.dev/src/contrib/gt_0.11.1.9000.tar.gz, - safetyCharts=url::https://safetygraphics.r-universe.dev/src/contrib/safetyCharts_0.4.0.tar.gz + gsm=gilead-biostats/gsm@v2.2.0, + gt=url::https://rstudio.r-universe.dev/src/contrib/gt_0.11.1.9000.tar.gz Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 +VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 8b1ccc71..b809fc14 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,15 +1,16 @@ # Generated by roxygen2: do not edit by hand +S3method(util_AsFunction,character) +S3method(util_AsFunction,default) export("%>%") +export(plugin_GetDependencySources) +export(plugin_InstallDependencySources) +export(plugin_LoadDependencies) export(plugin_Read) export(run_gsm_app) export(run_sample_gsm_app) export(sample_fnFetchData) import(shiny) -importFrom(cli,cli_alert) -importFrom(cli,cli_alert_info) -importFrom(ggplot2,ggplot) importFrom(magrittr,"%>%") importFrom(rlang,"%||%") importFrom(rlang,.data) -importFrom(safetyCharts,safetyOutlierExplorer_ui) diff --git a/R/aaa-shared.R b/R/aaa-shared.R index 1b7b01a3..c5470378 100644 --- a/R/aaa-shared.R +++ b/R/aaa-shared.R @@ -61,7 +61,8 @@ #' @param lParticipantMetadata `list` Named list of data describing a single #' participant. #' @param lPluginDefinition `list` A named list with required elements -#' `strTitle`, `fnUI`, and `fnServer`, and optional field `lConfig`. +#' `strTitle`, `fnUI`, and `fnServer`, and optional fields `packages` and +#' `lConfig`. Usually generated by [plugin_Read()]. #' @param lPlugins `list` Optional list of plugins to include in the app. #' @param lStudy `list` Named list of data describing the overall study. #' @param rctv_chrIDs `reactive character` A [shiny::reactive()] object that @@ -125,6 +126,11 @@ #' via [favawesome::fav()]. #' @param strFaviconColor `character` The hexcode or name of a color to use as #' the icon fill for [favawesome::fav()]. +#' @param strFunction `character` The name of a function, with or without +#' namespace ("reactive" or "shiny::reactive"). If a namespace is supplied, we +#' check that the package is installed, and attach it. The function can also +#' be supplied as a function or a purrr-style formula. See +#' [rlang::as_function()] (the `x` argument) for more details. #' @param strGroupID `character` A `GroupID` to focus on. #' @param strGroupLabelKey `character` Value for the group label key. Default: #' `"InvestigatorLastName"`. diff --git a/R/gsm.app-package.R b/R/gsm.app-package.R index dec93786..db2e3754 100644 --- a/R/gsm.app-package.R +++ b/R/gsm.app-package.R @@ -3,14 +3,7 @@ ## usethis namespace: start #' @import shiny -#' @importFrom cli cli_alert -#' @importFrom cli cli_alert_info -#' @importFrom ggplot2 ggplot #' @importFrom rlang %||% #' @importFrom rlang .data -#' @importFrom safetyCharts safetyOutlierExplorer_ui ## usethis namespace: end NULL - -# Import from safetyCharts is temporary to allow the rest of the setup to -# simulate a plugin defined outside of the package. diff --git a/R/mod_MetricTable_Server.R b/R/mod_MetricTable_Server.R index 55d07ade..5c10f8c5 100644 --- a/R/mod_MetricTable_Server.R +++ b/R/mod_MetricTable_Server.R @@ -13,12 +13,15 @@ mod_MetricTable_Server <- function( # Update the widget when the source data changes. rctv_tbl <- shiny::reactive({ req(rctv_dfResults()) - gsm::Report_MetricTable( + rmt <- gsm::Report_MetricTable( rctv_dfResults(), dfGroups = dfGroups, strGroupLevel = "Site" - ) %>% - out_gtInteractive() + ) + if (inherits(rmt, "gt_tbl")) { + return(out_gtInteractive(rmt)) + } + return(out_gtPlaceholder("metric with flagged sites")) }) # Extract the data back out of the widget. diff --git a/R/mod_Plugins_Server.R b/R/mod_Plugins_Server.R index 60471c7c..9478cc48 100644 --- a/R/mod_Plugins_Server.R +++ b/R/mod_Plugins_Server.R @@ -15,7 +15,7 @@ mod_Plugins_Server <- function( if (!is.null(lPlugins)) { for (i in seq_along(lPlugins)) { lPlugin <- lPlugins[[i]] - fnServer <- rlang::as_function(lPlugin$shiny$Server) + fnServer <- util_AsFunction(lPlugin$shiny$Server) args_available <- list( fnFetchData = fnFetchData, rctv_strMetricID = rctv_strMetricID, diff --git a/R/mod_Plugins_UI.R b/R/mod_Plugins_UI.R index 3497059d..84bffe63 100644 --- a/R/mod_Plugins_UI.R +++ b/R/mod_Plugins_UI.R @@ -1,12 +1,14 @@ #' Plugins Wrapper UI #' #' @inheritParams shared-params +#' @returns Plugins UI elements, either as a tab (if there is only one plugin) +#' or in a drop-down list (for multiple plugins). #' @keywords internal mod_Plugins_UI <- function(id, lPlugins = NULL) { ns <- NS(id) if (!is.null(lPlugins)) { plugin_items <- purrr::imap(lPlugins, function(lPlugin, i) { - fnUI <- rlang::as_function(lPlugin$shiny$UI) + fnUI <- util_AsFunction(lPlugin$shiny$UI) bslib::nav_panel( title = lPlugin$meta$Name, rlang::inject({ diff --git a/R/plugin_Read.R b/R/plugin_Read.R index cc889665..a048b6d0 100644 --- a/R/plugin_Read.R +++ b/R/plugin_Read.R @@ -14,6 +14,7 @@ #' @export #' @examples #' aePlugin <- plugin_Read(system.file("plugins", "AE", package = "gsm.app")) +#' aePlugin plugin_Read <- function(strPath) { chrPluginFiles <- list.files(strPath, full.names = TRUE) lPluginDefinition <- plugin_ReadYaml(chrPluginFiles) @@ -33,7 +34,7 @@ plugin_Read <- function(strPath) { #' Process a Plugin YAML #' #' @inheritParams shared-params -#' @return A list with the validated plugin definition. +#' @returns A list with the validated plugin definition. #' @keywords internal plugin_ReadYaml <- function(chrPluginFiles, envCall = rlang::caller_env()) { lPluginDefinition <- plugin_ReadYamlFile(chrPluginFiles, envCall) @@ -43,7 +44,7 @@ plugin_ReadYaml <- function(chrPluginFiles, envCall = rlang::caller_env()) { #' Read a Plugin YAML #' #' @inheritParams shared-params -#' @return A list with a potential plugin definition. +#' @returns A list with a potential plugin definition. #' @keywords internal plugin_ReadYamlFile <- function(chrPluginFiles, envCall = rlang::caller_env()) { file_is_yaml <- grepl("\\.ya?ml$", chrPluginFiles, ignore.case = TRUE) @@ -61,11 +62,17 @@ plugin_ReadYamlFile <- function(chrPluginFiles, envCall = rlang::caller_env()) { return(yaml::read_yaml(chrPluginFiles[file_is_yaml])) } +#' Validate Plugin Definition +#' +#' @inheritParams shared-params +#' @returns The validated `lPluginDefinition`. +#' @keywords internal plugin_ValidateDefinition <- function( lPluginDefinition, envCall = rlang::caller_env() ) { chrRequiredFields <- c("meta", "shiny", "domains") + chrOptionalFields <- c("lConfig", "packages") validate_hasAllFields( lPluginDefinition, c("meta", "shiny", "domains"), @@ -74,7 +81,7 @@ plugin_ValidateDefinition <- function( ) validate_hasOnlyFields( lPluginDefinition, - c(chrRequiredFields, "lConfig"), + c(chrRequiredFields, chrOptionalFields), "Plugin defitions", envCall ) @@ -102,5 +109,93 @@ plugin_ValidateDefinition <- function( "Domains", envCall ) + if (length(lPluginDefinition$packages)) { + for (pkg in lPluginDefinition$packages) { + validate_hasAllFields( + pkg, + "name", + "Plugin definition package requirements", + envCall + ) + validate_hasOnlyFields( + pkg, + c("name", "remote"), + "Plugin definition package requirements", + envCall + ) + } + } return(lPluginDefinition) } + +#' Load Plugin Dependencies +#' +#' Load the package dependencies of a plugin. This is designed to be used in an +#' `app.R` file to ensure that the dependencies are detected by packages like +#' rsconnect. +#' +#' @inheritParams shared-params +#' +#' @returns `lPluginDefinition`, invisibly. This function is called for its side +#' effects. +#' @export +#' +#' @examplesIf interactive() +#' plugin_LoadDependencies(list(packages = list(list(name = "gsm.app")))) +plugin_LoadDependencies <- function(lPluginDefinition) { + for (pkg in lPluginDefinition$packages) { + suppressPackageStartupMessages(library(pkg$name, character.only = TRUE)) + } + return(invisible(lPluginDefinition)) +} + +#' Get Plugin Package Dependency Sources +#' +#' Retrieve a vector of sources for plugin package dependencies, to make it +#' easier to install those sources. This function is intended for use in +#' automated deployment systems, such as GitHub Actions. +#' +#' @inheritParams shared-params +#' +#' @returns A character vector of package sources, such as "ggplot2" (to install +#' from CRAN) or +#' "url::https://safetygraphics.r-universe.dev/src/contrib/safetyCharts_0.4.0.tar.gz" +#' (to install from a specific URL on r-universe). +#' @export +#' @examples +#' plugin_GetDependencySources( +#' list(packages = list( +#' list(name = "ggplot2"), +#' list(name = "gsm", remote = "Gilead-BioStats/gsm") +#' )) +#' ) +plugin_GetDependencySources <- function(lPluginDefinition) { + purrr::map_chr(lPluginDefinition$packages, function(pkg) { + if (length(pkg$remote)) { + return(pkg$remote) + } + return(pkg$name) + }) +} + +#' Install Plugin Package Dependencies +#' +#' Plugins can have additional dependencies that are invisible to the usual +#' CI/CD pipelines. Use this function to install any such dependencies using the +#' pak package. +#' +#' @inheritParams shared-params +#' +#' @returns `lPluginDefinition`, invisibly. This function is called for its side +#' effects. +#' @export +plugin_InstallDependencySources <- function(lPluginDefinition) { + # nocov start + rlang::check_installed("pak", "to install plugin dependencies") + chrSources <- plugin_GetDependencySources(lPluginDefinition) + for (pkg in chrSources) { + pak::pak(pkg) + } + return(invisible(lPluginDefinition)) + # nocov end +} diff --git a/R/utils-AsFunction.R b/R/utils-AsFunction.R new file mode 100644 index 00000000..5b246dc5 --- /dev/null +++ b/R/utils-AsFunction.R @@ -0,0 +1,21 @@ +#' Load a Function for a Plugin +#' +#' @inheritParams shared-params +#' +#' @returns The function, if it can be found. +#' @keywords internal +util_AsFunction <- function(strFunction) { + UseMethod("util_AsFunction") +} + +#' @export +util_AsFunction.default <- function(strFunction) { + rlang::as_function(strFunction) +} + +#' @export +util_AsFunction.character <- function(strFunction) { + fnFunction <- gsm::GetStrFunctionIfNamespaced(strFunction) + # Extra step to work around things that are still character. + rlang::as_function(fnFunction) +} diff --git a/R/utils-validate.R b/R/utils-validate.R index ab9e3401..ded65eab 100644 --- a/R/utils-validate.R +++ b/R/utils-validate.R @@ -1,7 +1,7 @@ #' Check that an object has all required fields #' #' @inheritParams shared-params -#' @return The validated object. +#' @returns The validated object. #' @keywords internal validate_hasAllFields <- function( x, @@ -26,7 +26,7 @@ validate_hasAllFields <- function( #' Check that an object has only the allowed fields #' #' @inheritParams shared-params -#' @return The validated object. +#' @returns The validated object. #' @keywords internal validate_hasOnlyFields <- function( x, @@ -51,7 +51,7 @@ validate_hasOnlyFields <- function( #' Check that a vector is in another vector #' #' @inheritParams shared-params -#' @return The validated object. +#' @returns The validated object. #' @keywords internal validate_in <- function( x, @@ -63,7 +63,7 @@ validate_in <- function( if (length(extra_values)) { gsmapp_abort( c( - "{strWhat} must be in these values: {.field {chrRequiredFields}}.", + "{strWhat} must be in these values: {.field {chrAllowedValues}}.", x = "Unknown values: {.field {extra_values}}." ), strClass = "vector-values", diff --git a/R/utils-wrangle.R b/R/utils-wrangle.R index c55d91d2..5b69ac43 100644 --- a/R/utils-wrangle.R +++ b/R/utils-wrangle.R @@ -86,7 +86,7 @@ findNonZeroDecimals <- function(dblX, intMaxDecimals = 5L) { #' Apply user-facing domain names #' #' @inheritParams shared-params -#' @return The list of domain dfs, with better user-facing names. +#' @returns The list of domain dfs, with better user-facing names. #' @keywords internal applyPrettyDomainNames <- function(lDomains) { chrDomains <- names(lDomains) diff --git a/app.R b/app.R index 965600a2..bc8779c9 100644 --- a/app.R +++ b/app.R @@ -1,8 +1,8 @@ # Launch the ShinyApp (Do not remove this comment) -library(shiny) pkgload::load_all(".", helpers = FALSE, attach_testthat = FALSE) aePlugin <- plugin_Read(system.file("plugins", "AE", package = "gsm.app")) +plugin_LoadDependencies(aePlugin) run_gsm_app( dfAnalyticsInput = gsm.app::sample_dfAnalyticsInput, @@ -15,8 +15,3 @@ run_gsm_app( strFavicon = Sys.getenv("GSMAPP_FAVICON", "angles-up"), strFaviconColor = Sys.getenv("GSMAPP_FAVICONCOLOR", colorScheme("red")) ) - -# run_sample_gsm_app( -# strFavicon = Sys.getenv("GSMAPP_FAVICON", "angles-up"), -# strFaviconColor = Sys.getenv("GSMAPP_FAVICONCOLOR", colorScheme("red")) -# ) diff --git a/inst/plugins/AE/AE.yml b/inst/plugins/AE/AE.yml index 2d730adb..436af88b 100644 --- a/inst/plugins/AE/AE.yml +++ b/inst/plugins/AE/AE.yml @@ -8,3 +8,7 @@ shiny: domains: - AE - SUBJ +packages: + - name: ggplot2 + - name: safetyCharts + remote: url::https://safetygraphics.r-universe.dev/src/contrib/safetyCharts_0.4.0.tar.gz diff --git a/man/mod_Plugins_UI.Rd b/man/mod_Plugins_UI.Rd index 03f6ce21..8f881e0a 100644 --- a/man/mod_Plugins_UI.Rd +++ b/man/mod_Plugins_UI.Rd @@ -11,6 +11,10 @@ mod_Plugins_UI(id, lPlugins = NULL) \item{lPlugins}{\code{list} Optional list of plugins to include in the app.} } +\value{ +Plugins UI elements, either as a tab (if there is only one plugin) +or in a drop-down list (for multiple plugins). +} \description{ Plugins Wrapper UI } diff --git a/man/plugin_GetDependencySources.Rd b/man/plugin_GetDependencySources.Rd new file mode 100644 index 00000000..6ca05d7b --- /dev/null +++ b/man/plugin_GetDependencySources.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin_Read.R +\name{plugin_GetDependencySources} +\alias{plugin_GetDependencySources} +\title{Get Plugin Package Dependency Sources} +\usage{ +plugin_GetDependencySources(lPluginDefinition) +} +\arguments{ +\item{lPluginDefinition}{\code{list} A named list with required elements +\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional fields \code{packages} and +\code{lConfig}. Usually generated by \code{\link[=plugin_Read]{plugin_Read()}}.} +} +\value{ +A character vector of package sources, such as "ggplot2" (to install +from CRAN) or +"url::https://safetygraphics.r-universe.dev/src/contrib/safetyCharts_0.4.0.tar.gz" +(to install from a specific URL on r-universe). +} +\description{ +Retrieve a vector of sources for plugin package dependencies, to make it +easier to install those sources. This function is intended for use in +automated deployment systems, such as GitHub Actions. +} +\examples{ +plugin_GetDependencySources( + list(packages = list( + list(name = "ggplot2"), + list(name = "gsm", remote = "Gilead-BioStats/gsm") + )) +) +} diff --git a/man/plugin_InstallDependencySources.Rd b/man/plugin_InstallDependencySources.Rd new file mode 100644 index 00000000..88b6d761 --- /dev/null +++ b/man/plugin_InstallDependencySources.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin_Read.R +\name{plugin_InstallDependencySources} +\alias{plugin_InstallDependencySources} +\title{Install Plugin Package Dependencies} +\usage{ +plugin_InstallDependencySources(lPluginDefinition) +} +\arguments{ +\item{lPluginDefinition}{\code{list} A named list with required elements +\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional fields \code{packages} and +\code{lConfig}. Usually generated by \code{\link[=plugin_Read]{plugin_Read()}}.} +} +\value{ +\code{lPluginDefinition}, invisibly. This function is called for its side +effects. +} +\description{ +Plugins can have additional dependencies that are invisible to the usual +CI/CD pipelines. Use this function to install any such dependencies using the +pak package. +} diff --git a/man/plugin_LoadDependencies.Rd b/man/plugin_LoadDependencies.Rd new file mode 100644 index 00000000..264bc3b1 --- /dev/null +++ b/man/plugin_LoadDependencies.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin_Read.R +\name{plugin_LoadDependencies} +\alias{plugin_LoadDependencies} +\title{Load Plugin Dependencies} +\usage{ +plugin_LoadDependencies(lPluginDefinition) +} +\arguments{ +\item{lPluginDefinition}{\code{list} A named list with required elements +\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional fields \code{packages} and +\code{lConfig}. Usually generated by \code{\link[=plugin_Read]{plugin_Read()}}.} +} +\value{ +\code{lPluginDefinition}, invisibly. This function is called for its side +effects. +} +\description{ +Load the package dependencies of a plugin. This is designed to be used in an +\code{app.R} file to ensure that the dependencies are detected by packages like +rsconnect. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +plugin_LoadDependencies(list(packages = list(list(name = "gsm.app")))) +\dontshow{\}) # examplesIf} +} diff --git a/man/plugin_Read.Rd b/man/plugin_Read.Rd index 35944292..f27e3e2a 100644 --- a/man/plugin_Read.Rd +++ b/man/plugin_Read.Rd @@ -23,4 +23,5 @@ these element definitions and any R files in the same directory. } \examples{ aePlugin <- plugin_Read(system.file("plugins", "AE", package = "gsm.app")) +aePlugin } diff --git a/man/plugin_ValidateDefinition.Rd b/man/plugin_ValidateDefinition.Rd new file mode 100644 index 00000000..524b9a9b --- /dev/null +++ b/man/plugin_ValidateDefinition.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plugin_Read.R +\name{plugin_ValidateDefinition} +\alias{plugin_ValidateDefinition} +\title{Validate Plugin Definition} +\usage{ +plugin_ValidateDefinition(lPluginDefinition, envCall = rlang::caller_env()) +} +\arguments{ +\item{lPluginDefinition}{\code{list} A named list with required elements +\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional fields \code{packages} and +\code{lConfig}. Usually generated by \code{\link[=plugin_Read]{plugin_Read()}}.} + +\item{envCall}{\code{environment} The environment from which this function was +called, for use in better error messages. This value should usually be left +as the default, or passed from the calling function if the calling function +also has an \code{envCall} argument.} +} +\value{ +The validated \code{lPluginDefinition}. +} +\description{ +Validate Plugin Definition +} +\keyword{internal} diff --git a/man/shared-params.Rd b/man/shared-params.Rd index cefa48e1..b973e4a6 100644 --- a/man/shared-params.Rd +++ b/man/shared-params.Rd @@ -90,7 +90,8 @@ as things like which group is selected.} participant.} \item{lPluginDefinition}{\code{list} A named list with required elements -\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional field \code{lConfig}.} +\code{strTitle}, \code{fnUI}, and \code{fnServer}, and optional fields \code{packages} and +\code{lConfig}. Usually generated by \code{\link[=plugin_Read]{plugin_Read()}}.} \item{lPlugins}{\code{list} Optional list of plugins to include in the app.} @@ -185,6 +186,12 @@ via \code{\link[favawesome:fav]{favawesome::fav()}}.} \item{strFaviconColor}{\code{character} The hexcode or name of a color to use as the icon fill for \code{\link[favawesome:fav]{favawesome::fav()}}.} +\item{strFunction}{\code{character} The name of a function, with or without +namespace ("reactive" or "shiny::reactive"). If a namespace is supplied, we +check that the package is installed, and attach it. The function can also +be supplied as a function or a purrr-style formula. See +\code{\link[rlang:as_function]{rlang::as_function()}} (the \code{x} argument) for more details.} + \item{strGroupID}{\code{character} A \code{GroupID} to focus on.} \item{strGroupLabelKey}{\code{character} Value for the group label key. Default: diff --git a/man/util_AsFunction.Rd b/man/util_AsFunction.Rd new file mode 100644 index 00000000..5f500141 --- /dev/null +++ b/man/util_AsFunction.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-AsFunction.R +\name{util_AsFunction} +\alias{util_AsFunction} +\title{Load a Function for a Plugin} +\usage{ +util_AsFunction(strFunction) +} +\arguments{ +\item{strFunction}{\code{character} The name of a function, with or without +namespace ("reactive" or "shiny::reactive"). If a namespace is supplied, we +check that the package is installed, and attach it. The function can also +be supplied as a function or a purrr-style formula. See +\code{\link[rlang:as_function]{rlang::as_function()}} (the \code{x} argument) for more details.} +} +\value{ +The function, if it can be found. +} +\description{ +Load a Function for a Plugin +} +\keyword{internal} diff --git a/tests/testthat/_snaps/mod_MetricTable_Server.md b/tests/testthat/_snaps/mod_MetricTable_Server.md index e29a4d5a..a8645a99 100644 --- a/tests/testthat/_snaps/mod_MetricTable_Server.md +++ b/tests/testthat/_snaps/mod_MetricTable_Server.md @@ -5,3 +5,10 @@ Output [1] "
\n \n
\n \n
\n" +# mod_MetricTable_Server works with no flags + + Code + test_html + Output + [1] "
\n \n \n \n \n \n \n \n \n \n \n \n
Please select a metric with flagged sites.
\n
\n" + diff --git a/tests/testthat/fixtures/plugins/package_extra_field/def.yml b/tests/testthat/fixtures/plugins/package_extra_field/def.yml new file mode 100644 index 00000000..a52672da --- /dev/null +++ b/tests/testthat/fixtures/plugins/package_extra_field/def.yml @@ -0,0 +1,15 @@ +meta: + Type: Plugin + ID: ID + Name: Title +shiny: + UI: mod_UI + Server: mod_Server +domains: + - AE + - SUBJ +packages: + - name: pkg1 + also: other_thing + - name: pkg2 + remote: remote_url diff --git a/tests/testthat/fixtures/plugins/package_missing_name/def.yml b/tests/testthat/fixtures/plugins/package_missing_name/def.yml new file mode 100644 index 00000000..ec1ea420 --- /dev/null +++ b/tests/testthat/fixtures/plugins/package_missing_name/def.yml @@ -0,0 +1,13 @@ +meta: + Type: Plugin + ID: ID + Name: Title +shiny: + UI: mod_UI + Server: mod_Server +domains: + - AE + - SUBJ +packages: + - name: pkg1 + - remote: remote_url diff --git a/tests/testthat/fixtures/plugins/package_ok/def.yml b/tests/testthat/fixtures/plugins/package_ok/def.yml new file mode 100644 index 00000000..e91e2183 --- /dev/null +++ b/tests/testthat/fixtures/plugins/package_ok/def.yml @@ -0,0 +1,14 @@ +meta: + Type: Plugin + ID: ID + Name: Title +shiny: + UI: mod_UI + Server: mod_Server +domains: + - AE + - SUBJ +packages: + - name: pkg1 + - name: pkg2 + remote: remote_url diff --git a/tests/testthat/helper-testServer.R b/tests/testthat/helper-testServer.R index 045e26f0..261566f9 100644 --- a/tests/testthat/helper-testServer.R +++ b/tests/testthat/helper-testServer.R @@ -1,3 +1,6 @@ +# Silently load shiny or it'll make noise during tests. +suppressPackageStartupMessages(library(shiny)) + testServer <- function(...) { suppressPackageStartupMessages( shiny::testServer(...) diff --git a/tests/testthat/test-data_Validate.R b/tests/testthat/test-data_Validate.R index 2615dad5..c71f1b05 100644 --- a/tests/testthat/test-data_Validate.R +++ b/tests/testthat/test-data_Validate.R @@ -20,31 +20,48 @@ test_that("validate_df returns dfs when they're ok", { }) test_that("Built-in dfResults passes validation", { - expect_no_error( - validate_dfResults(gsm.app::sample_dfResults) - ) + expect_no_error({ + test_result <- validate_dfResults(gsm.app::sample_dfResults) + }) + expect_s3_class(test_result, "tbl_df") }) test_that("Built-in dfGroups passes validation", { - expect_no_error( - validate_dfGroups(gsm.app::sample_dfGroups) - ) + expect_no_error({ + test_result <- validate_dfGroups(gsm.app::sample_dfGroups) + }) + expect_s3_class(test_result, "tbl_df") }) test_that("Built-in dfMetrics passes validation", { - expect_no_error( - validate_dfMetrics(gsm.app::sample_dfMetrics) - ) + expect_no_error({ + test_result <- validate_dfMetrics(gsm.app::sample_dfMetrics) + }) + expect_s3_class(test_result, "tbl_df") }) test_that("Built-in dfBounds passes validation", { - expect_no_error( - validate_dfBounds(gsm.app::sample_dfBounds) - ) + expect_no_error({ + test_result <- validate_dfBounds(gsm.app::sample_dfBounds) + }) + expect_s3_class(test_result, "tbl_df") }) test_that("Built-in dfAnalyticsInput passes validation", { - expect_no_error( - validate_dfAnalyticsInput(gsm.app::sample_dfAnalyticsInput) + expect_no_error({ + test_result <- validate_dfAnalyticsInput(gsm.app::sample_dfAnalyticsInput) + }) + expect_s3_class(test_result, "tbl_df") +}) + +test_that("validate_chrDomains fails gracefully", { + expect_error( + validate_chrDomains("NewDomain"), + "NewDomain", + class = "gsm.app-error-invalid_input" ) }) + +test_that("validate_chrDomains returns valid domains + SUBJ", { + expect_identical(validate_chrDomains("AE"), c("AE", "SUBJ")) +}) diff --git a/tests/testthat/test-mod_MetricTable_Server.R b/tests/testthat/test-mod_MetricTable_Server.R index 6a23325c..9855f6ec 100644 --- a/tests/testthat/test-mod_MetricTable_Server.R +++ b/tests/testthat/test-mod_MetricTable_Server.R @@ -59,3 +59,36 @@ test_that("mod_MetricTable_Server returns selected site", { } ) }) + +test_that("mod_MetricTable_Server works with no flags", { + call <- rlang::current_env() + + dfResults <- filter_byMetricID( + sample_dfResults[sample_dfResults$GroupLevel == "Site", ], + "Analysis_kri0008" + ) + dfResults <- dplyr::filter(dfResults, Flag == 0) + dfGroups <- sample_dfGroups + + testServer( + mod_MetricTable_Server, + args = list( + id = "testingModMetricTable", + rctv_dfResults = reactive(dfResults), + dfGroups = dfGroups, + rctv_strSiteID = reactive("None") + ), + { + test_result <- output$`gt-table` + expect_type(test_result, "list") + expect_named(test_result, c("html", "deps")) + test_html <- test_result$html + gt_id <- stringr::str_extract(test_html, 'div id="(\\w+)"', 1) + test_html <- stringr::str_replace_all(test_html, gt_id, "gtRandID") + expect_cleaned_html( + test_html, + call = call + ) + } + ) +}) diff --git a/tests/testthat/test-mod_Plugins_UI.R b/tests/testthat/test-mod_Plugins_UI.R index 3c4db25f..945baa4c 100644 --- a/tests/testthat/test-mod_Plugins_UI.R +++ b/tests/testthat/test-mod_Plugins_UI.R @@ -35,3 +35,9 @@ test_that("mod_Plugins_UI creates the expected UI with multiple plugins", { test_result }) }) + +# TODO: Test a plugin from a package. + +# TODO: Tests fail when I use a function name (like in real usage), but only +# when ran in the full suite, so it appears to be an environment issue. No luck +# so far getting testthat to behave. diff --git a/tests/testthat/test-plugin_Read.R b/tests/testthat/test-plugin_Read.R index 6e5dc52f..6074e61f 100644 --- a/tests/testthat/test-plugin_Read.R +++ b/tests/testthat/test-plugin_Read.R @@ -26,6 +26,34 @@ test_that("plugin_Read checks definition fields", { ) }) +test_that("plugin_Read works with package fields", { + path <- test_path("fixtures", "plugins", "package_ok") + expect_no_error({ + test_result <- plugin_Read(path) + }) + expect_identical( + test_result$packages, + list(list(name = "pkg1"), list(name = "pkg2", remote = "remote_url")) + ) +}) + +test_that("plugin_Read checks package fields", { + path <- test_path("fixtures", "plugins", "package_missing_name") + expect_error( + { + plugin_Read(path) + }, + class = "gsm.app-error-object-fields" + ) + path <- test_path("fixtures", "plugins", "package_extra_field") + expect_error( + { + plugin_Read(path) + }, + class = "gsm.app-error-object-fields" + ) +}) + test_that("plugin_Read reads associated R code", { path <- test_path("fixtures", "plugins", "has_r") expect_no_error({ @@ -49,3 +77,28 @@ test_that("plugin_Read returns the expected object", { ) ) }) + +test_that("plugin_LoadDependencies loads dependencies", { + skip_if_not_installed("here") + expect_false(rlang::is_attached(rlang::pkg_env_name("here"))) + withr::defer({ + if (rlang::is_attached(rlang::pkg_env_name("here"))) { + unloadNamespace("here") + } + }) + plugin_LoadDependencies(list(packages = list(list(name = "here")))) + expect_true(rlang::is_attached(rlang::pkg_env_name("here"))) +}) + +test_that("plugin_GetDependencySources gets plugin dependency sources", { + test_result <- plugin_GetDependencySources( + list(packages = list( + list(name = "ggplot2"), + list(name = "gsm", remote = "Gilead-BioStats/gsm@dev") + )) + ) + expect_identical( + test_result, + c("ggplot2", "Gilead-BioStats/gsm@dev") + ) +}) diff --git a/tests/testthat/test-utils-AsFunction.R b/tests/testthat/test-utils-AsFunction.R new file mode 100644 index 00000000..f0eec31e --- /dev/null +++ b/tests/testthat/test-utils-AsFunction.R @@ -0,0 +1,23 @@ +test_that("util_AsFunction works for unnamespaced functions", { + test_result <- util_AsFunction("mean") + expect_identical(test_result, mean) +}) + +test_that("util_AsFunction works for namespaced functions", { + test_result <- util_AsFunction("shiny::reactive") + expect_identical(test_result, shiny::reactive) +}) + +test_that("util_AsFunction works for bare functions", { + test_result <- util_AsFunction(mean) + expect_identical(test_result, mean) +}) + +test_that("util_AsFunction fails gracefully for non-installed packages", { + # Register as non-interactive even while testing these. + rlang::local_interactive(FALSE) + expect_error( + util_AsFunction("badpkg::func"), + class = "packageNotFoundError" + ) +}) diff --git a/tests/testthat/test-utils-validate.R b/tests/testthat/test-utils-validate.R new file mode 100644 index 00000000..b02ede4b --- /dev/null +++ b/tests/testthat/test-utils-validate.R @@ -0,0 +1,7 @@ +test_that("validate_in errors gracefully", { + expect_error( + validate_in(c("a", "b"), c("a", "d")), + "Unknown values", + class = "gsm.app-error-vector-values" + ) +}) diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 00000000..097b2416 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/plugins.Rmd b/vignettes/plugins.Rmd new file mode 100644 index 00000000..b35d9977 --- /dev/null +++ b/vignettes/plugins.Rmd @@ -0,0 +1,116 @@ +--- +title: "Plugins" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Plugins} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(gsm.app) +``` + +# Introduction + +The plugin system provides a flexible way to tailor applications to specific needs by incorporating additional features and dependencies. + +# Defining a Plugin + +A plugin is defined by a folder containing: + +- A YAML file with metadata and dependency information. +- Optional R scripts that define the necessary UI and server functions for the plugin. + +For example, this is the`AE.yml` file for our sample Adverse Events plugin: + +```yaml +meta: + Type: Plugin + ID: AE + Name: Adverse Events +shiny: + UI: mod_AE_UI + Server: mod_AE_Server +domains: + - AE + - SUBJ +packages: + - name: ggplot2 + - name: safetyCharts + remote: url::https://safetygraphics.r-universe.dev/src/contrib/safetyCharts_0.4.0.tar.gz +``` + +## meta + +The `meta` section must contain `Type: Plugin`, and `ID` that matches the name of the file, and a `Name:`. The `Name:` appears in the resulting app as the label for the tab containing the plugin. + +## shiny + +The `shiny` section specifies the names of the plugin module's UI and server functions. These functions can come from a package (included in `packages`, see below), or be defined in one or more R scripts in the plugin folder. + +## domains + +The `domains` section specifies the data domains that are used by the plugin. These domains will be loaded by the app, in addition to any domains specified in the `chrDomains` argument to `run_gsm_app()`. The domains can be any of the following: +- `AE` (Adverse Events) +- `DATACHG` (Data Changes) +- `DATAENT` (Data Entry) +- `ENROLL` (Enrollment) +- `LB` (Lab) +- `PD` (Protocol Deviations) +- `QUERY` (Queries) +- `STUDCOMP` (Study Completion) +- `SUBJ` (Subject Metadata) +- `SDRGCOMP` (Treatment Completion) + +## packages + +The `packages` section specifies packages used by the plugin. This field is particulaly important for deploying the app or using the app with a CI/CD system. + +# Launching an App with a Plugin + +Use `plugin_Read(strPath)` to read a plugin definition and prepare it for use in an app. Supply a list of one or more plugin definitions to the `run_gsm_app()` function through the `lPlugins` argument. + +For example, this code launches an app with our sample AE plugin: + +```{r launch, eval = FALSE} +aePlugin <- plugin_Read(system.file("plugins", "AE", package = "gsm.app")) +run_gsm_app( + dfAnalyticsInput = gsm.app::sample_dfAnalyticsInput, + dfBounds = gsm.app::sample_dfBounds, + dfGroups = gsm.app::sample_dfGroups, + dfMetrics = gsm.app::sample_dfMetrics, + dfResults = gsm.app::sample_dfResults, + fnFetchData = sample_fnFetchData, + lPlugins = list(aePlugin) +) +``` + +Note that `aePlugin` must be supplied inside an enclosing `list()`, to allow for multiple plugin definitions. + +# Deploying an App with a Plugin + +If you wish to deploy an app that uses one or more plugins using {renv} and/or {rsconnect}, you need to let the system know about the plugins used by your app. The `plugin_LoadDependencies()` function serves to alert such systems of your requirements. + +```{r load-dependencies, eval = FALSE} +plugin_LoadDependencies(aePlugin) +``` + +# Plugins in CI/CD + +To integrate plugins into a CI/CD pipeline, use the `plugin_InstallDependencySources()` function to install plugin dependencies. This function requires the {pak} package. + +```{r install-sources, eval = FALSE} +plugin_InstallDependencySources(aePlugin) +``` + +See the [`shinyapps-deploy.yaml` file used by this package](https://github.com/Gilead-BioStats/gsm.app/blob/dev/.github/workflows/shinyapps-deploy.yaml) for an example use of this function. + +If you wish to use something other than `pak::pak()` to install the dependencies, you can get a character vector of dependency sources with `plugin_GetDependencySources()`.