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 (r-lib/testthat#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

@@ -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:

.gitignore

@@ -42,3 +42,4 @@ docs
 
 rsconnect
 scratch.R
+inst/doc

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/[email protected],
-    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/[email protected],
+    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

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)

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"`.

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.

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.

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,

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({

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
+}

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)
+}

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",

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)