CRAN 0.4.8 Released (#12)

* CRAN 0.4.8 Released (#22) * update roxygen * update conversion * add_reset_button function * add tests * downloadFile: add option to show/hide rownames (#20) * add option to disable row.names in csv/tsv * push version * test updates, optional sidebar tabs (#21) * use tmp dir for conversion functions testing * New Feature - if the user only uses the Advanced Tab * refactoring * fix overwriting files R 3.4 * update shiny min version * readying for CRAN submission * comments for cran sub * spelling
cb4ds · Feb 12, 2020 · 3db7de5 · 3db7de5
1 parent d028a88
commit 3db7de5
Show file tree

Hide file tree

Showing 39 changed files with 1,189 additions and 56 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: periscope
 Type: Package
 Title: Enterprise Streamlined 'Shiny' Application Framework
-Version: 0.4.7
+Version: 0.4.8
 Authors@R: c(
     person("Constance", "Brett", email="connie@aggregate-genius.com", role = c("aut", "cre")),
     person("Isaac", "Neuhaus", role = "aut", comment = "canvasXpress JavaScript Library Maintainer"),
@@ -22,7 +22,7 @@ LazyData: true
 Depends:
     R (>= 3.4)
 Imports:
-    shiny (>= 1.0),
+    shiny (>= 1.1),
     shinydashboard (>= 0.5),
     shinydashboardPlus (>= 0.5),
     shinyBS (>= 0.61),
@@ -31,7 +31,7 @@ Imports:
     DT (>= 0.2),
     openxlsx (>= 3.0),
     ggplot2 (>= 2.2)
-RoxygenNote: 6.1.1
+RoxygenNote: 7.0.2
 Suggests:
     knitr,
     rmarkdown,

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_reset_button)
+export(add_right_sidebar)
 export(add_ui_body)
 export(add_ui_sidebar_advanced)
 export(add_ui_sidebar_basic)
@@ -14,5 +16,6 @@ export(downloadablePlotUI)
 export(downloadableTable)
 export(downloadableTableUI)
 export(get_url_parameters)
+export(remove_reset_button)
 export(set_app_parameters)
 export(ui_tooltip)
diff --git a/NEWS.md b/NEWS.md
@@ -1,16 +1,20 @@
 #Revisions and Change Log
 
+### v0.4.8
+* Added functionality to add or remove the reset button from an existing application
+* Added functionality to add the right sidebar to an existing application
+* Added ability to disable row.names in csv/tsv downloadFile
+* Update to allow only the Advanced tab to be used in the sidebar
+* Tested shiny 1.4 functionality - compatible
+
 ### v0.4.7
 * Added shinydashboard plus functionality for a right-hand sidebar as an option
 * Updated documentation and examples for shinydashboardplus functionality
 * Added a preference to turn off the reset application button
 
 ### v0.4.6
 * Bugfix - hide downloadable table button if there are no download functions defined
-* Updated tests to be compatable with the next release of htmltools (0.4, schloerke)
-
-### v0.4.5
-* Bugfix - downloadable table button was not appearing when created in a reactive block
+* Updated tests to be compatible with the next release of htmltools (0.4, schloerke)
 
 ### v0.4.4
 * Supporting openxlsx workbook format for xlsx downloads in addition to data tables

diff --git a/R/convert_template.R b/R/convert_template.R
@@ -0,0 +1,154 @@
+# Conversion functions for existing applications.
+
+
+ui_filename                <- "ui.R"
+ui_plus_filename           <- "ui_plus.R"
+ui_right_sidebar_filename  <- "ui_sidebar_right.R"
+reset_button_expression    <- "fw_create_sidebar\\(resetbutton = FALSE\\)"
+no_reset_button_expression <- "fw_create_sidebar\\(\\)"
+
+
+# Checks if the location contains a periscope application.
+.is_periscope_app <- function(location = ".") {
+    result <- TRUE
+    if (!all(file.exists(file.path(location, c("server.R", "ui.R", "global.R", "program"))))) {
+        result <- FALSE
+    }
+    result
+}
+
+
+#' Add the right sidebar to an existing application.
+#'
+#' @param location path of the existing application.
+#'
+#' @export
+add_right_sidebar <- function(location) {
+    tryCatch({
+        if (is.null(location) || location == "") {
+            warning("Add right sidebar conversion could not proceed, location cannot be empty!")
+        }
+        else if (!dir.exists(location)) {
+            warning("Add right sidebar conversion could not proceed, location=<", location, "> does not exist!")
+        }
+        else if (!.is_periscope_app(location)) {
+            warning("Add right sidebar conversion could not proceed, location=<", location, "> does not contain a valid periscope application!")
+        }
+        else {
+            usersep <- .Platform$file.sep
+
+            files_updated <- c()
+            # replace ui by ui_plus (take car of resetbutton!)
+            ui_content <- readLines(con = paste(location, ui_filename, sep = usersep))
+            # update ui if needed
+            if (!any(grepl("fw_create_right_sidebar", ui_content))) {
+                # check if resetbutton is disabled
+                reset_button <- TRUE
+                if (any(grepl(reset_button_expression, ui_content))) {
+                    reset_button <- FALSE
+                }
+                new_ui_content <- readLines(con = system.file("fw_templ", ui_plus_filename, package = "periscope"))
+                if (!reset_button) {
+                    new_ui_content <- gsub(no_reset_button_expression, reset_button_expression, new_ui_content)
+                }
+                writeLines(new_ui_content, con = paste(location, ui_filename, sep = usersep))   
+
+                # add right_sidebar file    
+                writeLines(readLines(con = system.file("fw_templ",  "p_blank", ui_right_sidebar_filename, package = "periscope")), 
+                           con = paste(location, "program", ui_right_sidebar_filename, sep = usersep))
+
+                files_updated <- c(files_updated, c(ui_filename, ui_right_sidebar_filename))
+            }
+
+            if (length(files_updated) > 0) {
+                message(paste("Add right sidebar conversion was successful. File(s) updated:",  paste(files_updated, collapse = ", ")))
+            } else {
+                message("Right sidebar already available, no conversion needed")  
+            }
+        }
+    },
+    warning = function(w) {
+        warning(w$message, call. = FALSE)
+    })
+    invisible(NULL)
+}
+
+#' Remove the reset button from an existing application.
+#'
+#' @param location path of the existing application.
+#'
+#' @export
+remove_reset_button <- function(location) {
+    tryCatch({
+        if (is.null(location) || location == "") {
+            warning("Remove reset button conversion could not proceed, location cannot be empty!")
+        }
+        else if (!dir.exists(location)) {
+            warning("Remove reset button conversion could not proceed, location=<", location, "> does not exist!")
+        }
+        else if (!.is_periscope_app(location)) {
+            warning("Remove reset button conversion could not proceed, location=<", location, "> does not contain a valid periscope application!")
+        }
+        else {
+            usersep <- .Platform$file.sep
+
+            files_updated <- c()
+            ui_content <- readLines(con = paste(location, ui_filename, sep = usersep))
+            # update ui if needed
+            if (!any(grepl(reset_button_expression, ui_content))) {
+                writeLines(gsub(no_reset_button_expression, reset_button_expression, ui_content), 
+                           con = paste(location, ui_filename, sep = usersep))
+                files_updated <- c(files_updated, ui_filename)
+            }
+            if (length(files_updated) > 0) {
+                message(paste("Remove reset button conversion was successful. File(s) updated:",  paste(files_updated, collapse = ",")))
+            } else {
+                message("Reset button already removed, no conversion needed")  
+            }
+        }
+    },
+    warning = function(w) {
+        warning(w$message, call. = FALSE)
+    })
+    invisible(NULL)
+}
+
+#' Add the reset button to an existing application.
+#'
+#' @param location path of the existing application.
+#'
+#' @export
+add_reset_button <- function(location) {
+    tryCatch({
+        if (is.null(location) || location == "") {
+            warning("Add reset button conversion could not proceed, location cannot be empty!")
+        }
+        else if (!dir.exists(location)) {
+            warning("Add reset button conversion could not proceed, location=<", location, "> does not exist!")
+        }
+        else if (!.is_periscope_app(location)) {
+            warning("Add reset button conversion could not proceed, location=<", location, "> does not contain a valid periscope application!")
+        }
+        else {
+            usersep <- .Platform$file.sep
+
+            files_updated <- c()
+            ui_content <- readLines(con = paste(location, ui_filename, sep = usersep))
+            # update ui if needed
+            if (any(grepl(reset_button_expression, ui_content))) {
+                writeLines(gsub(reset_button_expression, no_reset_button_expression, ui_content), 
+                           con = paste(location, ui_filename, sep = usersep))
+                files_updated <- c(files_updated, ui_filename)
+            }
+            if (length(files_updated) > 0) {
+                message(paste("Add reset button conversion was successful. File(s) updated:",  paste(files_updated, collapse = ",")))
+            } else {
+                message("Reset button already available, no conversion needed")  
+            }
+        }
+    },
+    warning = function(w) {
+        warning(w$message, call. = FALSE)
+    })
+    invisible(NULL)
+}
diff --git a/R/downloadFile.R b/R/downloadFile.R
@@ -194,11 +194,19 @@ downloadFile <- function(input, output, session, logger,
     writeFile <- function(type, data, file, logger, filename) {
         # tabular values
         if ((type == "csv") | (type == "tsv")) {
+            show_rownames <- attr(data, "show_rownames")
+            show_rownames <- !is.null(show_rownames) && show_rownames
+            show_colnames <- TRUE
+            if (show_rownames) {
+                show_colnames <- NA
+            }
+
             utils::write.table(data, file,
                                sep = ifelse(type == "tsv", "\t", ","),
                                dec = ".",
                                qmethod = "double",
-                               col.names = NA)
+                               col.names = show_colnames,
+                               row.names = show_rownames)
         }
         # excel file
         else if (type == "xlsx") {

diff --git a/R/fw_helpers_external.R b/R/fw_helpers_external.R
@@ -68,12 +68,16 @@ fw_create_sidebar <- function(resetbutton = shiny::isolate(.g_opts$reset_button)
     basic <- shiny::isolate(.g_opts$side_basic)
     adv   <- shiny::isolate(.g_opts$side_advanced)
 
+    if (!is.null(adv) && length(adv) > 0 && resetbutton) {
+        adv[[length(adv) + 1]] <- .appResetButton("appResetId")
+    }
+
     return(
         shinydashboard::dashboardSidebar(
             width = shiny::isolate(.g_opts$sidebar_size),
             .header_injection(),             #injected header elements
             .right_sidebar_injection(),
-            if (!is.null(adv[[1]])) {
+            if (!is.null(basic[[1]]) && !is.null(adv[[1]])) {
                 shiny::div(class = "tab-content",
                     shiny::tabsetPanel(
                         id = "Options",
@@ -83,12 +87,15 @@ fw_create_sidebar <- function(resetbutton = shiny::isolate(.g_opts$reset_button)
                             basic),
                         shiny::tabPanel(
                             shiny::isolate(.g_opts$side_advanced_label),
-                            adv,
-                            switch(resetbutton + 1, NULL, .appResetButton("appResetId")))))
+                            adv)))
+            }
+            else if (!is.null(basic[[1]]) && is.null(adv[[1]])) {
+                shiny::div(class = "notab-content",
+                           basic)
             }
-            else {
+            else if (is.null(basic[[1]]) && !is.null(adv[[1]])) {
                 shiny::div(class = "notab-content",
-                            basic)
+                           adv)
             }
         ) )
 }

diff --git a/R/generate_template.R b/R/generate_template.R
@@ -181,15 +181,19 @@ create_new_application <- function(name, location, sampleapp = FALSE, resetbutto
     if (dashboard_plus) {
         file.rename(paste(newloc, "ui_plus.R", sep = usersep), paste(newloc, "ui.R", sep = usersep))
         if (!is.null(right_sidebar_icon)) {
+            ui_file <- file(paste(newloc, "ui.R", sep = usersep), open = "r+")
             writeLines(gsub("fw_create_header_plus\\(", paste0("fw_create_header_plus\\(sidebar_right_icon = '", right_sidebar_icon, "'"), 
-                            readLines(con = paste(newloc, "ui.R", sep = usersep))), 
-                       con = paste(newloc, "ui.R", sep = usersep))
+                            readLines(con = ui_file)), 
+                       con = ui_file)
+            close(ui_file)
         }
     }
     if (!resetbutton) {
+        ui_file <- file(paste(newloc, "ui.R", sep = usersep), open = "r+")
         writeLines(gsub("fw_create_sidebar\\(", "fw_create_sidebar\\(resetbutton = FALSE", 
-                        readLines(con = paste(newloc, "ui.R", sep = usersep))), 
-                   con = paste(newloc, "ui.R", sep = usersep))
+                        readLines(con = ui_file)), 
+                   con = ui_file)
+        close(ui_file)
     }
 
     #subdir copies

diff --git a/cran-comments.md b/cran-comments.md
@@ -1,6 +1,6 @@
 ## Comments from Maintainer
 
-Enhancement to add a right sidebar, additional preference for reset button, documentation updates, etc.
+Enhancements and added functionality as detailed in News
 
 ---  
 
@@ -11,13 +11,13 @@ RStudio Server Pro (Ubuntu 18.04.2)
 
 * R 3.4.4  
 * R 3.5.3  
-* R 3.6.1
+* R 3.6.2
 
 Travis-CI (Ubuntu 16.04.6)
 
 * R 3.5.3
-* R 3.6.1
-* R devel (2019-11-23 r77455)
+* R 3.6.2
+* R devel (2020-02-12 r77798)
 
 WinBuilder
 
@@ -57,3 +57,4 @@ tools::package_dependencies(packages = c('periscope'),
 $periscope  
 character(0)
 ```
+
diff --git a/inst/fw_templ/p_example/plots.R b/inst/fw_templ/p_example/plots.R
@@ -6,6 +6,7 @@ library(lattice)
 data(mtcars)
 mtcars$cyl <- factor(mtcars$cyl, levels = c(4,6,8),
                      labels = c("4cyl", "6cyl", "8cyl"))
+attr(mtcars, "show_rownames") <- TRUE
 
 
 # -- plotting functions

diff --git a/man/add_reset_button.Rd b/man/add_reset_button.Rd
diff --git a/man/add_right_sidebar.Rd b/man/add_right_sidebar.Rd
diff --git a/man/add_ui_sidebar_advanced.Rd b/man/add_ui_sidebar_advanced.Rd
diff --git a/man/add_ui_sidebar_basic.Rd b/man/add_ui_sidebar_basic.Rd