Merge pull request #32 from simon-smart88/dev

Merge 0.4.0

Author: simon-smart88

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: shinyscholar
-Version: 0.3.0
+Version: 0.4.0
 Title: A Template for Creating Reproducible 'shiny' Applications
 Description: Create a skeleton 'shiny' application with create_template() that is
     reproducible, can be saved and meets academic standards for attribution.
@@ -36,6 +36,7 @@ Authors@R:
       person("Robert", "Muscarella", email = "bob.muscarella@gmail.com", role = "ctb"))
 Depends:
     R (>= 3.5.0),
+    bslib,
     gargoyle,
     leaflet (>= 2.0.2),
     shiny (>= 1.8.1)
@@ -48,15 +49,13 @@ Imports:
     tools,
     zip
 Suggests:
-    bslib,
     DT (>= 0.5),
     dplyr (>= 1.0.2),
-    future,
     httr2,
     knitcitations,
     leaflet.extras (>= 1.0.0),
     markdown,
-    promises,
+    mirai,
     R6,
     RColorBrewer,
     renv,

NAMESPACE

@@ -24,6 +24,7 @@ export(show_results)
 export(show_table)
 export(spurious)
 export(writeLog)
+import(bslib)
 import(gargoyle)
 import(leaflet)
 import(shiny)

NEWS.md

@@ -95,3 +95,16 @@ shinyscholar 0.3.0
 - Switched to use `shinyWidgets::radioGroupButtons()` for module selection menu
 - Added a description of the package structure to the README
 
+shinyscholar 0.4.0
+=============
+
+### Bug fixes
+- Fixed UI generation in `create_template()` 
+- Enter key no longer reruns a module when an error message is displayed
+- Fixed API calls in `select_query()` and `select_async()`
+
+### Changes
+- Stopped running {shinytest2} tests on CRAN 
+- Migrated from {promises} to {mirai} for running async tasks
+- Migrated to {bslib} layout functions and various UI tweaks
+- Added a small footer linking to the CRAN package to generated apps

R/create_template.R

@@ -36,8 +36,8 @@ tidy_purl <- function(params){
 #'  \item `map` logical. Whether or not the module interacts with the map
 #'  \item `result` logical. Whether or not the module produces results
 #'  \item `rmd` logical. Whether or not the module is included in the markdown
-#'  \item `save` logical. Whether or not the input values of the model should be saved
-#'  \item `download` logical. Whether or not the input values of the model should be saved
+#'  \item `save` logical. Whether or not the input values of the module should be saved
+#'  \item `download` logical. Whether or not the module should include a downloadHandler
 #'  \item `async` logical. Whether or not the module will run asynchronously
 #' }
 #' @param author character. Name of the author(s)
@@ -217,8 +217,7 @@ create_template <- function(path, name, common_objects, modules, author,
   if (async){
     import_line <- grep("*Imports*", description_lines)
     description_lines <- append(description_lines, "    bslib,", import_line)
-    description_lines <- append(description_lines, "    future,", import_line + 2)
-    description_lines <- append(description_lines, "    promises,", import_line + 7)
+    description_lines <- append(description_lines, "    mirai,", import_line + 7)
   }
 
   if (include_map){
@@ -233,6 +232,21 @@ create_template <- function(path, name, common_objects, modules, author,
 
   writeLines(description_lines, file.path(path, "DESCRIPTION"))
 
+  # Package info ====
+
+  package_params <- c(
+    file = system.file("app_skeleton", "package.Rmd", package = "shinyscholar"),
+    list(name = name)
+  )
+
+  package_lines <- tidy_purl(package_params)
+
+  if (!include_map){
+    package_lines <- gsub("leaflet ", "", package_lines)
+  }
+
+  writeLines(package_lines, file.path(path, "R", paste0(name,"-package.R")))
+
   # Create common list ====
   # add always present objects to common
   common_objects_internal <- c(common_objects, c("meta", "logger", "state"))
@@ -306,23 +320,9 @@ create_template <- function(path, name, common_objects, modules, author,
 
   component_interface_target <- grep("*Rmd/text_intro_tab.Rmd*", ui_lines) + 1
   for (i in 1:nrow(components)){
-    ui_lines <- append(ui_lines, c(glue::glue('          # {toupper(components$long_component[i])} ####'),
-                                                 '           conditionalPanel(',
-                                      glue::glue('          "input.tabs == \'{components$component[i]}\'",'),
-                                      glue::glue('          div("Component: {components$long_component[i]}", class = "componentName"),'),
-                                      glue::glue('          help_comp_ui("{components$component[i]}Help"),'),
-                                                 '          shinyWidgets::radioGroupButtons(',
-                                      glue::glue('          "{components$component[i]}Sel", "Modules Available:",'),
-                                      glue::glue('          choices = insert_modules_options("{components$component[i]}"),'),
-                                                 '          direction = "vertical",',
-                                                 '          status = "outline-secondary",',
-                                                 '          width = "100%"',
-                                                 '          ),',
-                                                 '          tags$hr(),',
-                                      glue::glue('          insert_modules_ui("{components$component[i]}")'),
-                                                 '          ),'),
-                                                 component_interface_target)
-    component_interface_target <- component_interface_target + 13
+    comp_ui <- glue::glue('          insert_modules_ui("{components$component[i]}", "{components$long_component[i]}"),')
+    ui_lines <- append(ui_lines, comp_ui, component_interface_target)
+    component_interface_target <- component_interface_target + 1
   }
   writeLines(ui_lines, file.path(path, "inst", "shiny", "ui.R"))
 
@@ -504,7 +504,7 @@ create_template <- function(path, name, common_objects, modules, author,
   file.copy(www_files, file.path(path, "inst", "shiny"), recursive = TRUE)
 
   # copy helpers ====
-  helper_file <- system.file("shiny", "helpers.R", package = "shinyscholar")
+  helper_file <- system.file("shiny", "ui_helpers.R", package = "shinyscholar")
   file.copy(helper_file, file.path(path, "inst", "shiny"))
 
   helper_function_params <- c(

R/helper_functions.R

@@ -46,11 +46,10 @@ spurious <- function(x) {
   bslib::accordion(x)
   DT::renderDataTable(x)
   dplyr::add_count(x)
-  future::as.cluster(x)
   httr2::curl_help(x)
   leaflet.extras::removeDrawToolbar(x)
+  mirai::mirai(x)
   markdown::html_format(x)
-  promises::as.promise(x)
   R6::R6Class(x)
   RColorBrewer::brewer.pal(x)
   rintrojs::introjs(x)

R/select_async_f.R

@@ -56,7 +56,7 @@ select_async <- function(poly, date, token, async = FALSE) {
 
   bbox <- c(min(poly[,1]), max(poly[,2]), max(poly[,1]), min(poly[,2]))
 
-  search_url <- glue::glue("https://ladsweb.modaps.eosdis.nasa.gov/api/v2/content/archives?products=MCD15A2H&temporalRanges={date}&regions=[BBOX]W{bbox[1]}%20N{bbox[2]}%20E{bbox[3]}%20S{bbox[4]}")
+  search_url <- glue::glue("https://ladsweb.modaps.eosdis.nasa.gov/api/v2/content/archives?products=MCD15A2H&temporalRanges={date}&regions=[BBOX]W{bbox[1]}%20N{bbox[2]}%20E{bbox[3]}%20S{bbox[4]}&archiveSets=61")
   check <- check_url(search_url)
 
   if (!is.null(check)){

R/select_query_f.R

@@ -93,7 +93,7 @@ select_query <- function(poly, date, token, logger = NULL) {
 
   bbox <- c(min(poly[,1]), max(poly[,2]), max(poly[,1]), min(poly[,2]))
 
-  search_url <- glue::glue("https://ladsweb.modaps.eosdis.nasa.gov/api/v2/content/archives?products=MCD15A2H&temporalRanges={date}&regions=[BBOX]W{bbox[1]}%20N{bbox[2]}%20E{bbox[3]}%20S{bbox[4]}")
+  search_url <- glue::glue("https://ladsweb.modaps.eosdis.nasa.gov/api/v2/content/archives?products=MCD15A2H&temporalRanges={date}&regions=[BBOX]W{bbox[1]}%20N{bbox[2]}%20E{bbox[3]}%20S{bbox[4]}&archiveSets=61")
   check <- check_url(search_url)
 
   if (!is.null(check)){

R/shinyscholar-package.R

@@ -14,6 +14,6 @@
 #'   function \code{\link{run_shinyscholar}} and requires
 #'   \code{install.packages("shinyscholar", dependencies = TRUE)}.
 #'
-#' @import shiny leaflet gargoyle
 #' @importFrom magrittr "%>%"
+#' @import bslib gargoyle leaflet shiny
 NULL

README.md

@@ -1,4 +1,5 @@
-# shinyscholar (v0.3.0)
+# shinyscholar (v0.4.0)
+
 [![R CMD check](https://github.com/simon-smart88/shinyscholar/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/simon-smart88/shinyscholar/actions/workflows/R-CMD-check.yaml)
 [![CRAN Status](https://www.r-pkg.org/badges/version/shinyscholar)](https://cran.r-project.org/package=shinyscholar)
 [![CRAN Downloads](https://cranlogs.r-pkg.org/badges/shinyscholar)](https://cran.r-project.org/package=shinyscholar)
@@ -217,14 +218,12 @@ Further modules can be added using `create_module()` which creates the four file
 Support for asynchronous operations was added in v0.2.0 using the new `ExtendedTask` feature added in `{shiny}` v1.8.1. This has the advantage of allowing long-running operations to run in the background whilst the app remains responsive to the user and any other users connected to the same instance. Running modules asynchronously increases complexity however and requires several changes to structure of modules and the app itself. The `select_async` module contains an implementation that is functionally identical to `select_query` but runs asynchronously. 
 
 ##### Running tasks
-`common$tasks` is a list that stores details of all the asynchronous tasks. Each task is added to the list above the `observeEvent()` in the `<identifier>_module_server` function as `common$tasks$<identifier>`. The task contains the module's function wrapped by `promises::future_promise()` and bound to a `bslib::bind_task_button()` which disables the button when the task is running:
+`common$tasks` is a list that stores details of all the asynchronous tasks. Each task is added to the list above the `observeEvent()` in the `<identifier>_module_server` function as `common$tasks$<identifier>`. The task contains the module's function wrapped by `mirai::mirai()` and bound to a `bslib::bind_task_button()` which disables the button when the task is running:
 
 ```R
 common$tasks$<identifier> <- ExtendedTask$new(function(...) {
-    promises::future_promise({
-      <identifer>(...)
-    })
-  }) |> bslib::bind_task_button("run")
+  mirai::mirai(run(...), environment(), .args = list(run = <identifier>))
+}) |> bslib::bind_task_button("run")
 ```
 
 The task is invoked inside the `observeEvent()` by calling `common$tasks$<identifier>$invoke()` with the arguments of the module's function. As in the default implementation, metadata should be stored at this point when the function is called.

inst/app_skeleton/DESCRIPTION

@@ -6,6 +6,7 @@ Authors@R:
     c(person("Simon E. H.", "Smart", email = "simon.smart@cantab.net", role = c("aut","cre")))
 Depends:
     R (>= 3.5.0),
+    bslib,
     gargoyle,
     shiny (>= 1.8.1)
 Imports: