finish the use_template_app function that builds a shiny app skeleton

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: recon.ui
 Type: Package
-Title: Template of Shiny GUI for RECON Packages
+Title: Template of Shiny Apps for RECON Packages
 Version: 1.0.0
 Authors@R: c(person("Thibaut", "Jombart", role = c("aut", "cre"), email =
   "thibautjombart@gmail.com"),
   person("Dean", "Attali", role = c("aut"), email =
   "daattali@gmail.com"),
   person("Schumacher", "Dirk", role = c("aut"), email =
   "mail@dirk-schumacher.net"))
-Description: Provides skeletons for shiny GUI for RECON package.
+Description: Provides skeletons for shiny apps for RECON package.
 License: MIT + file LICENSE
 URL: http://www.repidemicsconsortium.org/recon.ui/
 BugReports: http://github.com/reconhub/recon.ui/issues

R/use_template_app.R

@@ -1,8 +1,29 @@
+#' Use a Shiny app template for the current package
+#'
+#' Generate a skeleton Shiny app for the current package. This function must be
+#' called from the root directory of an R package.
+#' @param path The path where the Shiny app will be created
+#' @param overwrite set to \code{TRUE} if you want to force the Shiny app to
+#' overwrite any existing Shiny apps in the given \code{path}
 #' @export
-use_template_app <- function(pkg_name = "mypackage") {
-  path <- file.path(getwd(), "shiny")
+use_template_app <- function(path = "inst/shiny", overwrite = FALSE) {
+
+  pkg_name <- get_package_name()
+  if (is.null(pkg_name)) {
+    stop("'use_template_app' can only be called from the root directory of an R package.", call. = FALSE)
+  }
+
+  path <- file.path(getwd(), path)
+  if (dir.exists(path)) {
+    if (!overwrite) {
+      stop("The directory '", path, "' already exists. Either choose a different path for the shiny app, or use the 'overwrite = TRUE' argument.", call. = FALSE)
+    }
+  }
+  unlink(path, recursive = TRUE, force = TRUE)
   dir.create(path, showWarnings = FALSE, recursive = TRUE)
+  path <- normalizePath(path)
 
+  # Copy all the template files and render them using whisker templates
   data <- list(
     pkg_name = pkg_name
   )
@@ -15,5 +36,27 @@ use_template_app <- function(pkg_name = "mypackage") {
     writeLines(template_out, file_out)
   })
 
-  message("Created shiny app template at ", path)
+  if (file.exists("README.md")) {
+    file.copy("README.md", file.path(path, "help.md"), overwrite = TRUE)
+  }
+
+  message("Created shiny app at\n", path)
+  invisible(NULL)
+}
+
+get_package_name <- function() {
+  if (!file.exists("DESCRIPTION")) {
+    return(NULL)
+  }
+
+  lines <- readLines("DESCRIPTION")
+  regex <- "^Package: (.*)"
+  pkg_line <- which(grepl(regex, lines))
+  if (length(pkg_line) == 0) {
+    return(NULL)
+  }
+
+  pkg_line <- pkg_line[1]
+  pkg_name <- sub(regex, "\\1", lines[pkg_line])
+  pkg_name
 }

inst/templates/shinyapp/server.R

@@ -1,12 +1,37 @@
 function(input, output, session) {
+
+  # The dataset the user chooses from the data import module
   main_data <- dataimport$server()
 
   output$session_info <- renderPrint({
     sessionInfo()
   })
 
+  # Dynamically generate the module for remapping variables
+  mapcolumns_module <- reactive({
+    data <- main_data()
+    shinyHelpers::mapcolumnsModule(
+      id = "mapcolumns",
+      data = data,
+      names = c("dob", "name"),
+      multiple = c(FALSE, FALSE),
+      labels = c("Choose the variable denoting the date of birth",
+                 "Choose the variable corresponding to the patient's name")
+    )
+  })
+  output$mapcolumns_output <- renderUI({
+    mapcolumns_module()$ui()
+  })
+  mapcolumns <- reactive({ mapcolumns_module()$server() })
+
   output$plot <- renderPlot({
-    # Your plot goes here
-    # plot(main_data())
+
+    # Generate the plot when the user clicks on the Analyze button
+    if (input$analyze == 0) return()
+
+    # You can access the mapped variables as reactive variables
+    isolate({
+      plot(rnorm(100), xlab = mapcolumns()$dob(), ylab = mapcolumns()$name())
+    })
   })
 }

inst/templates/shinyapp/ui.R

@@ -1,8 +1,15 @@
 recon.ui::reconNavbarPage(
   "{{{ pkg_name }}}",
+
   tabPanel(
     "Data",
-    dataimport$ui()
+
+    # Data import module
+    dataimport$ui(),
+    br(),
+
+    # Column (variable) mappin module
+    uiOutput("mapcolumns_output")
   ),
 
   tabPanel(