From b5d9fe8cc7dcd57adc897b1255ab1614613ffd30 Mon Sep 17 00:00:00 2001 From: ginberg Date: Tue, 24 Mar 2020 00:18:29 +0100 Subject: [PATCH] left sidebar parameter (#23) * refactoring * fix and update conversion functions * documentation * remove_left_sidebar function * update conversion functions --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/convert_template.R | 126 +++++++-- R/fw_helpers_external.R | 73 ++--- R/fw_helpers_internal.R | 6 + R/generate_template.R | 89 +++--- .../fw_templ/p_example/server_local_no_left.R | 220 +++++++++++++++ .../p_example/server_local_plus_no_left.R | 264 ++++++++++++++++++ inst/fw_templ/ui_no_sidebar.R | 20 ++ inst/fw_templ/ui_plus_no_sidebar.R | 24 ++ man/add_left_sidebar.Rd | 14 + man/create_new_application.Rd | 9 +- tests/testthat/sample_app_no_sidebar/global.R | 14 + .../program/data/.gitignore | 3 + .../sample_app_no_sidebar/program/fxn/plots.R | 57 ++++ .../program/fxn/program_helpers.R | 29 ++ .../sample_app_no_sidebar/program/global.R | 26 ++ .../program/server_global.R | 41 +++ .../program/server_local.R | 229 +++++++++++++++ .../sample_app_no_sidebar/program/ui_body.R | 93 ++++++ .../program/ui_sidebar.R | 50 ++++ tests/testthat/sample_app_no_sidebar/server.R | 28 ++ tests/testthat/sample_app_no_sidebar/ui.R | 20 ++ .../sample_app_no_sidebar/www/img/loader.gif | Bin 0 -> 2892 bytes .../sample_app_no_sidebar/www/img/tooltip.png | Bin 0 -> 540231 bytes tests/testthat/test_convert_application.R | 50 +++- tests/testthat/test_create_new_application.R | 19 +- tests/testthat/test_ui_functions.R | 80 ++++-- vignettes/new-application.Rmd | 10 +- 29 files changed, 1460 insertions(+), 137 deletions(-) create mode 100755 inst/fw_templ/p_example/server_local_no_left.R create mode 100755 inst/fw_templ/p_example/server_local_plus_no_left.R create mode 100644 inst/fw_templ/ui_no_sidebar.R create mode 100644 inst/fw_templ/ui_plus_no_sidebar.R create mode 100644 man/add_left_sidebar.Rd create mode 100644 tests/testthat/sample_app_no_sidebar/global.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/data/.gitignore create mode 100644 tests/testthat/sample_app_no_sidebar/program/fxn/plots.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/fxn/program_helpers.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/global.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/server_global.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/server_local.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/ui_body.R create mode 100644 tests/testthat/sample_app_no_sidebar/program/ui_sidebar.R create mode 100644 tests/testthat/sample_app_no_sidebar/server.R create mode 100644 tests/testthat/sample_app_no_sidebar/ui.R create mode 100644 tests/testthat/sample_app_no_sidebar/www/img/loader.gif create mode 100644 tests/testthat/sample_app_no_sidebar/www/img/tooltip.png diff --git a/DESCRIPTION b/DESCRIPTION index 1c50967..b62714d 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: periscope Type: Package Title: Enterprise Streamlined 'Shiny' Application Framework -Version: 0.4.8 +Version: 0.4.9.9000 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"), diff --git a/NAMESPACE b/NAMESPACE index aa715cc..55b0f33 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(add_left_sidebar) export(add_reset_button) export(add_right_sidebar) export(add_ui_body) diff --git a/R/convert_template.R b/R/convert_template.R index d69089d..d10898d 100644 --- a/R/convert_template.R +++ b/R/convert_template.R @@ -1,11 +1,16 @@ # 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\\(\\)" +ui_filename <- "ui.R" +ui_no_sidebar_filename <- "ui_no_sidebar.R" +ui_plus_filename <- "ui_plus.R" +ui_plus_no_sidebar_filename <- "ui_plus_no_sidebar.R" +ui_left_sidebar_filename <- "ui_sidebar.R" +ui_right_sidebar_filename <- "ui_sidebar_right.R" +create_left_sidebar_expr <- "fw_create_sidebar\\(" +create_left_sidebar_closed_expr <- "fw_create_sidebar\\(\\)" +no_reset_button_expr <- "fw_create_sidebar\\(resetbutton = FALSE" +no_reset_button_closed_expr <- "fw_create_sidebar\\(resetbutton = FALSE\\)" # Checks if the location contains a periscope application. @@ -17,6 +22,58 @@ no_reset_button_expression <- "fw_create_sidebar\\(\\)" result } +#' Add the left sidebar to an existing application. +#' +#' @param location path of the existing application. +#' +#' @export +add_left_sidebar <- function(location) { + tryCatch({ + if (is.null(location) || location == "") { + warning("Add left sidebar conversion could not proceed, location cannot be empty!") + } + else if (!dir.exists(location)) { + warning("Add left sidebar conversion could not proceed, location=<", location, "> does not exist!") + } + else if (!.is_periscope_app(location)) { + warning("Add left sidebar 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)) + ui_content_formatted <- gsub(" ", "", ui_content) + # update ui if needed + if (any(grepl("showsidebar=FALSE", ui_content_formatted))) { + if (any(grepl("fw_create_right_sidebar", ui_content_formatted))) { + new_ui_content <- readLines(con = system.file("fw_templ", ui_plus_filename, package = "periscope")) + } else { + new_ui_content <- readLines(con = system.file("fw_templ", ui_filename, package = "periscope")) + } + if (any(grepl("resetbutton=FALSE", ui_content_formatted))) { + new_ui_content <- gsub(create_left_sidebar_closed_expr, no_reset_button_closed_expr, new_ui_content) + } + writeLines(new_ui_content, con = paste(location, ui_filename, sep = usersep)) + + # add left_sidebar file + writeLines(readLines(con = system.file("fw_templ", "p_blank", ui_left_sidebar_filename, package = "periscope")), + con = paste(location, "program", ui_left_sidebar_filename, sep = usersep)) + + files_updated <- c(files_updated, c(ui_filename, ui_left_sidebar_filename)) + } + if (length(files_updated) > 0) { + message(paste("Add left sidebar conversion was successful. File(s) updated:", paste(files_updated, collapse = ", "))) + } else { + message("Left sidebar already available, no conversion needed") + } + } + }, + warning = function(w) { + warning(w$message, call. = FALSE) + }) + invisible(NULL) +} #' Add the right sidebar to an existing application. #' @@ -39,17 +96,18 @@ add_right_sidebar <- function(location) { files_updated <- c() # replace ui by ui_plus (take car of resetbutton!) - ui_content <- readLines(con = paste(location, ui_filename, sep = usersep)) + ui_content <- gsub(" ", "", 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 + if (any(grepl("resetbutton=FALSE", 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) + if (!any(grepl("showsidebar=FALSE", ui_content))) { + new_ui_content <- readLines(con = system.file("fw_templ", ui_plus_filename, package = "periscope")) + if (!reset_button) { + new_ui_content <- gsub(create_left_sidebar_closed_expr, no_reset_button_closed_expr, new_ui_content) + } } writeLines(new_ui_content, con = paste(location, ui_filename, sep = usersep)) @@ -94,14 +152,18 @@ remove_reset_button <- function(location) { files_updated <- c() ui_content <- readLines(con = paste(location, ui_filename, sep = usersep)) + ui_content_formatted <- gsub(" ", "", ui_content) # 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 = ","))) + if (!any(grepl("resetbutton=FALSE", ui_content_formatted))) { + if (any(grepl("showsidebar=FALSE", ui_content_formatted))) { + message("Left sidebar not available, reset button cannot be removed") + } else { + new_ui_content <- gsub(create_left_sidebar_expr, no_reset_button_expr, ui_content) + writeLines(new_ui_content, + con = paste(location, ui_filename, sep = usersep)) + files_updated <- c(files_updated, ui_filename) + message(paste("Remove reset button conversion was successful. File(s) updated:", paste(files_updated, collapse = ","))) + } } else { message("Reset button already removed, no conversion needed") } @@ -133,17 +195,25 @@ add_reset_button <- function(location) { usersep <- .Platform$file.sep files_updated <- c() - ui_content <- readLines(con = paste(location, ui_filename, sep = usersep)) + ui_content <- readLines(con = paste(location, ui_filename, sep = usersep)) + ui_content_formatted <- gsub(" ", "", ui_content) # 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 = ","))) + if (any(grepl("resetbutton=FALSE", ui_content_formatted))) { + if (any(grepl("showsidebar=FALSE", ui_content_formatted))) { + message("Left sidebar is not available, please first run 'add_left_sidebar'") + } else { + new_ui_content <- gsub(no_reset_button_expr, create_left_sidebar_expr, ui_content) + writeLines(new_ui_content, + con = paste(location, ui_filename, sep = usersep)) + files_updated <- c(files_updated, ui_filename) + message(paste("Add reset button conversion was successful. File(s) updated:", paste(files_updated, collapse = ","))) + } } else { - message("Reset button already available, no conversion needed") + if (any(grepl("showsidebar=FALSE", ui_content_formatted))) { + message("Left sidebar is not available, please first run 'add_left_sidebar'") + } else { + message("Reset button already available, no conversion needed") + } } } }, diff --git a/R/fw_helpers_external.R b/R/fw_helpers_external.R index 4501c7f..e174da4 100755 --- a/R/fw_helpers_external.R +++ b/R/fw_helpers_external.R @@ -64,40 +64,47 @@ fw_create_header_plus <- function(sidebar_right_icon = shiny::isolate(.g_opts$si } # Framework UI Left Sidebar Creation -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") +fw_create_sidebar <- function(showsidebar = shiny::isolate(.g_opts$show_left_sidebar), resetbutton = shiny::isolate(.g_opts$reset_button)) { + result <- NULL + if (showsidebar) { + 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") + } + result <- shinydashboard::dashboardSidebar( + width = shiny::isolate(.g_opts$sidebar_size), + .header_injection(), #injected header elements + .right_sidebar_injection(), + if (!is.null(basic[[1]]) && !is.null(adv[[1]])) { + shiny::div(class = "tab-content", + shiny::tabsetPanel( + id = "Options", + selected = shiny::isolate(.g_opts$side_basic_label), + shiny::tabPanel( + shiny::isolate(.g_opts$side_basic_label), + basic), + shiny::tabPanel( + shiny::isolate(.g_opts$side_advanced_label), + adv))) + } + else if (!is.null(basic[[1]]) && is.null(adv[[1]])) { + shiny::div(class = "notab-content", + basic) + } + else if (is.null(basic[[1]]) && !is.null(adv[[1]])) { + shiny::div(class = "notab-content", + adv) + }) + } else { + result <- shinydashboard::dashboardSidebar(width = 0, + collapsed = TRUE, + .header_injection(), + .right_sidebar_injection(), + .remove_sidebar_toggle()) } - - return( - shinydashboard::dashboardSidebar( - width = shiny::isolate(.g_opts$sidebar_size), - .header_injection(), #injected header elements - .right_sidebar_injection(), - if (!is.null(basic[[1]]) && !is.null(adv[[1]])) { - shiny::div(class = "tab-content", - shiny::tabsetPanel( - id = "Options", - selected = shiny::isolate(.g_opts$side_basic_label), - shiny::tabPanel( - shiny::isolate(.g_opts$side_basic_label), - basic), - shiny::tabPanel( - shiny::isolate(.g_opts$side_advanced_label), - adv))) - } - else if (!is.null(basic[[1]]) && is.null(adv[[1]])) { - shiny::div(class = "notab-content", - basic) - } - else if (is.null(basic[[1]]) && !is.null(adv[[1]])) { - shiny::div(class = "notab-content", - adv) - } - ) ) + result } # Framework UI Right Sidebar Creation diff --git a/R/fw_helpers_internal.R b/R/fw_helpers_internal.R index 1c973e8..615db84 100755 --- a/R/fw_helpers_internal.R +++ b/R/fw_helpers_internal.R @@ -23,6 +23,7 @@ reset_wait = 5000, #milliseconds show_userlog = TRUE, body_elements = c(), + show_left_sidebar = TRUE, side_basic = .g_sidebar_default_value, side_basic_label = "Basic", side_advanced = .g_sidebar_default_value, @@ -64,6 +65,11 @@ }, 5000);")) } +.remove_sidebar_toggle <- function() { + shiny::tags$script(shiny::HTML("$('[class~=\"sidebar-toggle\"]').remove(); + $('[class~=\"logo\"]').css('background-color', '#3c8dbc');")) +} + # Returns the custom css as HTML .framework_css <- function() { return( shiny::HTML(" diff --git a/R/generate_template.R b/R/generate_template.R index 525661d..e635d46 100755 --- a/R/generate_template.R +++ b/R/generate_template.R @@ -15,6 +15,7 @@ #' @param resetbutton whether the reset button should be added on the Advanced (left) sidebar. #' @param rightsidebar parameter to set the right sidebar. It can be TRUE/FALSE or a character #' containing the name of a shiny::icon(). +#' @param leftsidebar whether the left sidebar should be enabled. #' #' @section Name: #' The \code{name} directory must not exist in \code{location}. If the code @@ -103,10 +104,12 @@ #' rightsidebar = "table") #' #' # blank app named 'myblankapp' created in a temp dir -#' create_new_application(name = 'mytestapp', location = tempdir()) +#' create_new_application(name = 'myblankapp', location = tempdir()) +#' # blank app named 'myblankapp' without a left sidebar created in a temp dir +#' create_new_application(name = 'myblankapp', location = tempdir(), leftsidebar = FALSE) #' #' @export -create_new_application <- function(name, location, sampleapp = FALSE, resetbutton = TRUE, rightsidebar = FALSE) { +create_new_application <- function(name, location, sampleapp = FALSE, resetbutton = TRUE, rightsidebar = FALSE, leftsidebar = TRUE) { usersep <- .Platform$file.sep newloc <- paste(location, name, sep = usersep) @@ -132,8 +135,8 @@ create_new_application <- function(name, location, sampleapp = FALSE, resetbutto } } .create_dirs(newloc, usersep) - .copy_fw_files(newloc, usersep, resetbutton, dashboard_plus, right_sidebar_icon) - .copy_program_files(newloc, usersep, sampleapp, resetbutton, dashboard_plus) + .copy_fw_files(newloc, usersep, resetbutton, dashboard_plus, leftsidebar, right_sidebar_icon) + .copy_program_files(newloc, usersep, sampleapp, resetbutton, leftsidebar, dashboard_plus) message("Framework creation was successful.") } @@ -164,7 +167,7 @@ create_new_application <- function(name, location, sampleapp = FALSE, resetbutto } # Create Framework Files ---------------------------- -.copy_fw_files <- function(newloc, usersep, resetbutton = TRUE, dashboard_plus = FALSE, right_sidebar_icon = NULL) { +.copy_fw_files <- function(newloc, usersep, resetbutton = TRUE, dashboard_plus = FALSE, leftsidebar = TRUE, right_sidebar_icon = NULL) { files <- c("global.R", "server.R") if (dashboard_plus) { @@ -188,11 +191,28 @@ create_new_application <- function(name, location, sampleapp = FALSE, resetbutto 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 = ui_file)), - con = ui_file) + if (leftsidebar) { + 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 = ui_file)), + con = ui_file) + close(ui_file) + } + } else { + ui_file <- file(paste(newloc, "ui.R", sep = usersep), open = "r") + ui_content <- readLines(con = ui_file) + close(ui_file) + source_positions <- grep("source", ui_content) + remove_positions <- seq(source_positions[1], source_positions[2] - 1) + ui_content <- ui_content[-remove_positions] + if (resetbutton) { + ui_content <- gsub("fw_create_sidebar\\(\\)", "fw_create_sidebar\\(showsidebar = FALSE\\)", ui_content) + } else { + ui_content <- gsub("fw_create_sidebar\\(\\)", "fw_create_sidebar\\(showsidebar = FALSE, resetbutton = FALSE\\)", ui_content) + } + ui_file <- file(paste(newloc, "ui.R", sep = usersep), open = "w") + writeLines(ui_content, con = ui_file) close(ui_file) } @@ -210,41 +230,42 @@ create_new_application <- function(name, location, sampleapp = FALSE, resetbutto } # Create Program Files ---------------------------- -.copy_program_files <- function(newloc, usersep, sampleapp, resetbutton = TRUE, dashboard_plus = FALSE) { - files <- c("global.R", - "server_global.R", - "server_local.R", - "ui_body.R") - if (sampleapp && !resetbutton) { - files <- c(files, "ui_sidebar_no_reset.R") - } else { - files <- c(files, "ui_sidebar.R") +.copy_program_files <- function(newloc, usersep, sampleapp, resetbutton = TRUE, leftsidebar = TRUE, dashboard_plus = FALSE) { + files <- list("global.R" = "global.R", + "server_global.R" = "server_global.R", + "server_local.R" = "server_local.R", + "ui_body.R" = "ui_body.R") + + if (leftsidebar) { + files["ui_sidebar.R"] <- "ui_sidebar.R" } - if (dashboard_plus) { - files <- c(files, "ui_sidebar_right.R") - if (sampleapp) { - files <- c(files, "server_local_plus.R") + files["ui_sidebar_right.R"] <- "ui_sidebar_right.R" + } + if (sampleapp) { + if (dashboard_plus) { + if (leftsidebar) { + names(files)[grepl("server_local.R", names(files))] <- "server_local_plus.R" + } else { + names(files)[grepl("server_local.R", names(files))] <- "server_local_plus_no_left.R" + } + } else if (!dashboard_plus && !leftsidebar) { + names(files)[grepl("server_local.R", names(files))] <- "server_local_no_left.R" + } + if (leftsidebar && !resetbutton) { + names(files)[grepl("ui_sidebar.R", names(files))] <- "ui_sidebar_no_reset.R" } - } else { - files <- c(files, "server_local.R") } - + targetdir <- paste(newloc, "program", sep = usersep) sourcedir <- paste("fw_templ", ifelse(sampleapp, "p_example", "p_blank"), sep = usersep) - for (file in files) { + for (file in names(files)) { writeLines(readLines( con = system.file(sourcedir, file, package = "periscope")), - con = paste(targetdir, file, sep = usersep)) - } - if (sampleapp && dashboard_plus) { - file.rename(paste(targetdir, "server_local_plus.R", sep = usersep), paste(targetdir, "server_local.R", sep = usersep)) - } - if (sampleapp && !resetbutton) { - file.rename(paste(targetdir, "ui_sidebar_no_reset.R", sep = usersep), paste(targetdir, "ui_sidebar.R", sep = usersep)) + con = paste(targetdir, files[[file]], sep = usersep)) } #subdir copies for sampleapp diff --git a/inst/fw_templ/p_example/server_local_no_left.R b/inst/fw_templ/p_example/server_local_no_left.R new file mode 100755 index 0000000..5f3fb82 --- /dev/null +++ b/inst/fw_templ/p_example/server_local_no_left.R @@ -0,0 +1,220 @@ +# ---------------------------------------- +# -- PROGRAM server_local.R -- +# ---------------------------------------- +# USE: Session-specific variables and +# functions for the main reactive +# shiny server functionality. All +# code in this file will be put into +# the framework inside the call to +# shinyServer(function(input, output, session) +# in server.R +# +# NOTEs: +# - All variables/functions here are +# SESSION scoped and are ONLY +# available to a single session and +# not to the UI +# +# - For globally scoped session items +# put var/fxns in server_global.R +# +# FRAMEWORK VARIABLES +# input, output, session - Shiny +# ss_userAction.Log - Reactive Logger S4 object +# ---------------------------------------- + +# -- IMPORTS -- + + +# -- VARIABLES -- + + +# -- FUNCTIONS -- +source(paste("program", "fxn", "program_helpers.R", sep = .Platform$file.sep)) +source(paste("program", "fxn", "plots.R", sep = .Platform$file.sep)) + + + +# ---------------------------------------- +# -- SHINY SERVER CODE -- +# ---------------------------------------- + +# -- Initialize UI Elements +output$proginfo <- renderUI({ + list(p("All program-specific (i.e. application-specific) code should be ", + "modified/added in the ", strong("program subfolder"), + " of the framework"), + hr(), + p("Sidebar elements are setup and registered to the framework in ", + "program/ui_sidebar.R"), + p("UI body boxes (such as this one) are registered to the framework ", + "in program/ui_body.R."), + p("Rendering handles and reactivity are programmed in ", + "program/server_local.R for session-specific functionality. If ", + "application-wide functionality is useful across all users that ", + "should be added into server_global.R. Scoping information is in ", + "the top comment of all program example files.") ) + }) + +output$tooltips <- renderUI({ + list(hr(), + p(ui_tooltip(id = "ex1", + label = "Tooltips", + text = "Example tooltip text"), + "can be added with the following code in the UI:"), + p(pre("U: ui_tooltip('tooltipID', 'label text (optional)', 'text content')")) ) + }) + +output$busyind <- renderUI({ + list(hr(), + p("There is an automatic wait indicator in the navbar when the shiny ", + "server session is busy."), + div(align = "center", + bsButton("showWorking", + label = "Show application busy indicator for 5 seconds", + style = "primary")) ) + }) + +output$download <- renderUI({ + list( + hr(), + p("Data download buttons for single-option (no choice of format) or ", + "multiple choices of formats can be added by specifying the ", + "extensions and corresponding data functions with the ", + "following code:"), + p(pre("U: downloadFileButton('uiID', list(extensions))"), + pre("S: callModule(downloadFile, 'uiID', logger, 'filenameroot', list(datafxns)"), + "Single Download: ", + downloadFileButton("exampleDownload1", c("csv"), "csv"), + "Multiple-choice Download: ", + downloadFileButton("exampleDownload2", + c("csv", "xlsx", "tsv"), "Download options")) ) + }) + +output$alerts <- renderUI({ + list(hr(), + p("There are three standardized locations for alerts. To create ", + "an alert call the following on the server: ", + pre('S: createAlert(session, location, content = "Alert Text", ...)'), + 'LOCATION can be: "bodyAlert", See the ', em("alertBS"), + "documentation for more information on styles and other options"), + div(align = "center", + bsButton( "exampleBodyAlert", + label = "Body", + style = "info", + append = FALSE, + width = "25%")) ) + }) + +output$loginfo <- renderUI({ + list(p("The collapsed ", + strong("User Action Log"), em("below"), + "is the standardized footer added by the framework.", + "To create actions to the framework call one of the logging ", + "functions like: ", + pre('logXXXX("Your Log Message with %s, %s parameters", parm1, parm2, logger = ss_userAction.Log)')), + p("The XXXX should be replaced by an actual log level like 'info', 'debug', 'warn' or 'error'. + The framework will handle updating the footer UI element every ", + "time the log is added to. It is important to note that the log ", + "rolls over for each session. The log files are kept in the ", + "/log directory and named 'actions.log'. ONE old copy of ", + "the log is kept as 'actions.log.last"), + p("See the ", em("logging"), "documentation for more information ", + "on functions and other options") ) + }) + +output$hover_info <- renderUI({ + hover <- input$examplePlot2_hover + point <- nearPoints(mtcars, hover, + xvar = "wt", yvar = "mpg", + maxpoints = 1) + if (nrow(point) == 0) { + return(NULL) + } + else { + left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left) + left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left) + + top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom) + top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top) + + style <- paste0("position:absolute;", + "z-index:100;", + "background-color: rgba(245, 245, 245, 0.85); ", + "left:", left_px + 2, "px; top:", top_px + 2, "px;") + + return(wellPanel(class = "well-sm", + style = style, + HTML(" Car: ", rownames(point))) ) + } +}) + +# -- CanvasXpress Plot Example + +output$examplePlot1 <- renderCanvasXpress({ + plot_htmlwidget() +}) + +loginfo("Be Sure to Remember to Log ALL user actions", + logger = ss_userAction.Log) + +# -- Setup Download Modules with Functions we want called +callModule(downloadFile, "exampleDownload1", ss_userAction.Log, + "examplesingle", + list(csv = load_data1)) +callModule(downloadFile, "exampleDownload2", ss_userAction.Log, + "examplemulti", + list(csv = load_data2, xlsx = load_data2, tsv = load_data2)) +callModule(downloadableTable, "exampleDT1", ss_userAction.Log, + "exampletable", + list(csv = load_data3, tsv = load_data3), + load_data3, + rownames = FALSE) + +callModule(downloadablePlot, "examplePlot2", ss_userAction.Log, + filenameroot = "plot2_ggplot", + downloadfxns = list(jpeg = plot2ggplot, + csv = plot2ggplot_data), + aspectratio = 1.5, + visibleplot = plot2ggplot) + +callModule(downloadablePlot, "examplePlot3", ss_userAction.Log, + filenameroot = "plot3_lattice", + aspectratio = 2, + downloadfxns = list(png = plot3lattice, + tiff = plot3lattice, + txt = plot3lattice_data, + tsv = plot3lattice_data), + visibleplot = plot3lattice) + +# -- Observe UI Changes +observeEvent(input$exampleBasicAlert, { + loginfo("Sidebar Basic Alert Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarBasicAlert", + style = "success", + content = "Example Basic Sidebar Alert") +}) + +observeEvent(input$exampleAdvancedAlert, { + loginfo("Sidebar Advanced Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarAdvancedAlert", + style = "warning", + content = "Example Advanced Sidebar Alert") + +}) + +observeEvent(input$exampleBodyAlert, { + loginfo("Body Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "bodyAlert", style = "info", append = FALSE, + content = paste("Example Body Alert - Append set to FALSE,", + "so only one alert will show")) +}) + +observeEvent(input$showWorking, { + loginfo("Show Busy Indicator Button Pushed", + logger = ss_userAction.Log) + Sys.sleep(5) +}) diff --git a/inst/fw_templ/p_example/server_local_plus_no_left.R b/inst/fw_templ/p_example/server_local_plus_no_left.R new file mode 100755 index 0000000..c3bd95a --- /dev/null +++ b/inst/fw_templ/p_example/server_local_plus_no_left.R @@ -0,0 +1,264 @@ +# ---------------------------------------- +# -- PROGRAM server_local.R -- +# ---------------------------------------- +# USE: Session-specific variables and +# functions for the main reactive +# shiny server functionality. All +# code in this file will be put into +# the framework inside the call to +# shinyServer(function(input, output, session) +# in server.R +# +# NOTEs: +# - All variables/functions here are +# SESSION scoped and are ONLY +# available to a single session and +# not to the UI +# +# - For globally scoped session items +# put var/fxns in server_global.R +# +# FRAMEWORK VARIABLES +# input, output, session - Shiny +# ss_userAction.Log - Reactive Logger S4 object +# ---------------------------------------- + +# -- IMPORTS -- + + +# -- VARIABLES -- + + +# -- FUNCTIONS -- +source(paste("program", "fxn", "program_helpers.R", sep = .Platform$file.sep)) +source(paste("program", "fxn", "plots.R", sep = .Platform$file.sep)) + + +plot2_data <- reactive({ + result <- plot2ggplot_data() + if (!input$enableGGPlot) { + result <- NULL + } + result +}) + +plot2 <- reactive({ + result <- NULL + if (!is.null(plot2_data())) { + result <- plot2ggplot() + } + result +}) + +plot3_data <- reactive({ + result <- plot3lattice_data() + if (!input$enableLatticePlot) { + result <- NULL + } + result +}) + +plot3 <- reactive({ + result <- NULL + if (!is.null(plot3_data())) { + result <- plot3lattice() + } + result +}) + +# ---------------------------------------- +# -- SHINY SERVER CODE -- +# ---------------------------------------- + +# -- Initialize UI Elements +output$proginfo <- renderUI({ + list(p("All program-specific (i.e. application-specific) code should be ", + "modified/added in the ", strong("program subfolder"), + " of the framework"), + hr(), + p("Sidebar elements are setup and registered to the framework in ", + "program/ui_sidebar.R"), + p("UI body boxes (such as this one) are registered to the framework ", + "in program/ui_body.R."), + p("Rendering handles and reactivity are programmed in ", + "program/server_local.R for session-specific functionality. If ", + "application-wide functionality is useful across all users that ", + "should be added into server_global.R. Scoping information is in ", + "the top comment of all program example files.") ) + }) + +output$tooltips <- renderUI({ + list(hr(), + p(ui_tooltip(id = "ex1", + label = "Tooltips", + text = "Example tooltip text"), + "can be added with the following code in the UI:"), + p(pre("U: ui_tooltip('tooltipID', 'label text (optional)', 'text content')")) ) + }) + +output$busyind <- renderUI({ + list(hr(), + p("There is an automatic wait indicator in the navbar when the shiny ", + "server session is busy."), + div(align = "center", + bsButton("showWorking", + label = "Show application busy indicator for 5 seconds", + style = "primary")) ) + }) + +output$download <- renderUI({ + list( + hr(), + p("Data download buttons for single-option (no choice of format) or ", + "multiple choices of formats can be added by specifying the ", + "extensions and corresponding data functions with the ", + "following code:"), + p(pre("U: downloadFileButton('uiID', list(extensions))"), + pre("S: callModule(downloadFile, 'uiID', logger, 'filenameroot', list(datafxns)"), + "Single Download: ", + downloadFileButton("exampleDownload1", c("csv"), "csv"), + "Multiple-choice Download: ", + downloadFileButton("exampleDownload2", + c("csv", "xlsx", "tsv"), "Download options")) ) + }) + +output$alerts <- renderUI({ + list(hr(), + p("There are three standardized locations for alerts. To create ", + "an alert call the following on the server: ", + pre('S: createAlert(session, location, content = "Alert Text", ...)'), + 'LOCATION can be: "bodyAlert", See the ', em("alertBS"), + "documentation for more information on styles and other options"), + div(align = "center", + bsButton( "exampleBodyAlert", + label = "Body", + style = "info", + append = FALSE, + width = "25%")) ) +}) + +output$loginfo <- renderUI({ + list(p("The collapsed ", + strong("User Action Log"), em("below"), + "is the standardized footer added by the framework.", + "To create actions to the framework call one of the logging ", + "functions like: ", + pre('logXXXX("Your Log Message with %s, %s parameters", parm1, parm2, logger = ss_userAction.Log)')), + p("The XXXX should be replaced by an actual log level like 'info', 'debug', 'warn' or 'error'. + The framework will handle updating the footer UI element every ", + "time the log is added to. It is important to note that the log ", + "rolls over for each session. The log files are kept in the ", + "/log directory and named 'actions.log'. ONE old copy of ", + "the log is kept as 'actions.log.last"), + p("See the ", em("logging"), "documentation for more information ", + "on functions and other options") ) + }) + +output$hover_info <- renderUI({ + hover <- input$examplePlot2_hover + point <- nearPoints(mtcars, hover, + xvar = "wt", yvar = "mpg", + maxpoints = 1) + if (nrow(point) == 0) { + return(NULL) + } + else { + left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left) + left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left) + + top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom) + top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top) + + style <- paste0("position:absolute;", + "z-index:100;", + "background-color: rgba(245, 245, 245, 0.85); ", + "left:", left_px + 2, "px; top:", top_px + 2, "px;") + + return(wellPanel(class = "well-sm", + style = style, + HTML(" Car: ", rownames(point))) ) + } +}) + +# -- CanvasXpress Plot Example + +output$examplePlot1 <- renderCanvasXpress({ + result <- plot_htmlwidget() + if (!input$enableCXPlot) { + result <- canvasXpress(destroy = TRUE) + } + result +}) + +loginfo("Be Sure to Remember to Log ALL user actions", + logger = ss_userAction.Log) + +# -- Setup Download Modules with Functions we want called +callModule(downloadFile, "exampleDownload1", ss_userAction.Log, + "examplesingle", + list(csv = load_data1)) +callModule(downloadFile, "exampleDownload2", ss_userAction.Log, + "examplemulti", + list(csv = load_data2, xlsx = load_data2, tsv = load_data2)) +callModule(downloadableTable, "exampleDT1", ss_userAction.Log, + "exampletable", + list(csv = load_data3, tsv = load_data3), + load_data3, + rownames = FALSE) + +callModule(downloadablePlot, "examplePlot2", ss_userAction.Log, + filenameroot = "plot2_ggplot", + downloadfxns = list(jpeg = plot2, + csv = plot2_data), + aspectratio = 1.5, + visibleplot = plot2) + +callModule(downloadablePlot, "examplePlot3", ss_userAction.Log, + filenameroot = "plot3_lattice", + aspectratio = 2, + downloadfxns = list(png = plot3, + tiff = plot3, + txt = plot3_data, + tsv = plot3_data), + visibleplot = plot3) + +# -- Observe UI Changes +observeEvent(input$exampleBasicAlert, { + loginfo("Sidebar Basic Alert Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarBasicAlert", + style = "success", + content = "Example Basic Sidebar Alert") +}) + +observeEvent(input$exampleAdvancedAlert, { + loginfo("Sidebar Advanced Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarAdvancedAlert", + style = "warning", + content = "Example Advanced Sidebar Alert") + +}) + +observeEvent(input$exampleRightAlert, { + loginfo("Sidebar Right Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarRightAlert", + style = "danger", + content = "Example Right Sidebar Alert") + +}) + +observeEvent(input$exampleBodyAlert, { + loginfo("Body Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "bodyAlert", style = "info", append = FALSE, + content = paste("Example Body Alert - Append set to FALSE,", + "so only one alert will show")) +}) + +observeEvent(input$showWorking, { + loginfo("Show Busy Indicator Button Pushed", + logger = ss_userAction.Log) + Sys.sleep(5) +}) diff --git a/inst/fw_templ/ui_no_sidebar.R b/inst/fw_templ/ui_no_sidebar.R new file mode 100644 index 0000000..c0206da --- /dev/null +++ b/inst/fw_templ/ui_no_sidebar.R @@ -0,0 +1,20 @@ +# ------------------------------------------------- +# -- FRAMEWORK ui.R -- +# ------------------------------------------------- +# NOTEs: -- +# Program code goes in "program" directory files -- +# ------------------------------------------------- +# ***** DO NOT EDIT THIS FILE ***** -- +# ------------------------------------------------- + +library(shinydashboard) + +periscope:::fw_reset_app_options() + +source(paste("program", "ui_body.R", sep = .Platform$file.sep), + local = TRUE) + + +dashboardPage(periscope:::fw_create_header(), + periscope:::fw_create_sidebar(showsidebar = FALSE), + periscope:::fw_create_body()) diff --git a/inst/fw_templ/ui_plus_no_sidebar.R b/inst/fw_templ/ui_plus_no_sidebar.R new file mode 100644 index 0000000..cfdc2ad --- /dev/null +++ b/inst/fw_templ/ui_plus_no_sidebar.R @@ -0,0 +1,24 @@ +# ------------------------------------------------- +# -- FRAMEWORK ui.R -- +# ------------------------------------------------- +# NOTEs: -- +# Program code goes in "program" directory files -- +# ------------------------------------------------- +# ***** DO NOT EDIT THIS FILE ***** -- +# ------------------------------------------------- + +library(shinydashboardPlus) + +periscope:::fw_reset_app_options() + +source(paste("program", "ui_sidebar_right.R", sep = .Platform$file.sep), + local = TRUE) +source(paste("program", "ui_body.R", sep = .Platform$file.sep), + local = TRUE) + + +dashboardPagePlus(periscope:::fw_create_header_plus(), + periscope:::fw_create_sidebar(showsidebar = FALSE), + periscope:::fw_create_body(), + periscope:::fw_create_right_sidebar(), + sidebar_fullCollapse = TRUE) diff --git a/man/add_left_sidebar.Rd b/man/add_left_sidebar.Rd new file mode 100644 index 0000000..41dacad --- /dev/null +++ b/man/add_left_sidebar.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/convert_template.R +\name{add_left_sidebar} +\alias{add_left_sidebar} +\title{Add the left sidebar to an existing application.} +\usage{ +add_left_sidebar(location) +} +\arguments{ +\item{location}{path of the existing application.} +} +\description{ +Add the left sidebar to an existing application. +} diff --git a/man/create_new_application.Rd b/man/create_new_application.Rd index a236ddf..f02f0ce 100644 --- a/man/create_new_application.Rd +++ b/man/create_new_application.Rd @@ -9,7 +9,8 @@ create_new_application( location, sampleapp = FALSE, resetbutton = TRUE, - rightsidebar = FALSE + rightsidebar = FALSE, + leftsidebar = TRUE ) } \arguments{ @@ -23,6 +24,8 @@ create_new_application( \item{rightsidebar}{parameter to set the right sidebar. It can be TRUE/FALSE or a character containing the name of a shiny::icon().} + +\item{leftsidebar}{whether the left sidebar should be enabled.} } \description{ Creates ready-to-use templated application files using the periscope @@ -125,7 +128,9 @@ create_new_application(name = 'mytestapp', location = tempdir(), sampleapp = TRU rightsidebar = "table") # blank app named 'myblankapp' created in a temp dir -create_new_application(name = 'mytestapp', location = tempdir()) +create_new_application(name = 'myblankapp', location = tempdir()) +# blank app named 'myblankapp' without a left sidebar created in a temp dir +create_new_application(name = 'myblankapp', location = tempdir(), leftsidebar = FALSE) } \seealso{ diff --git a/tests/testthat/sample_app_no_sidebar/global.R b/tests/testthat/sample_app_no_sidebar/global.R new file mode 100644 index 0000000..9407999 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/global.R @@ -0,0 +1,14 @@ +# ------------------------------------------------- +# -- FRAMEWORK global.R -- +# ------------------------------------------------- +# NOTEs: -- +# Program code goes in "program" directory files -- +# ------------------------------------------------- +# ***** DO NOT EDIT THIS FILE ***** -- +# ------------------------------------------------- + +library(periscope) +library(shinyBS) + + +source(paste("program", "global.R", sep = .Platform$file.sep), local = TRUE) diff --git a/tests/testthat/sample_app_no_sidebar/program/data/.gitignore b/tests/testthat/sample_app_no_sidebar/program/data/.gitignore new file mode 100644 index 0000000..94548af --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/data/.gitignore @@ -0,0 +1,3 @@ +* +*/ +!.gitignore diff --git a/tests/testthat/sample_app_no_sidebar/program/fxn/plots.R b/tests/testthat/sample_app_no_sidebar/program/fxn/plots.R new file mode 100644 index 0000000..d2b4283 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/fxn/plots.R @@ -0,0 +1,57 @@ +library(ggplot2) +library(lattice) + + +# -- data for plots +data(mtcars) +mtcars$cyl <- factor(mtcars$cyl, levels = c(4,6,8), + labels = c("4cyl", "6cyl", "8cyl")) + + +# -- plotting functions + +plot2ggplot <- function() { + plot <- ggplot(data = mtcars, aes(x = wt, y = mpg)) + + geom_point(aes(color = cyl)) + + theme(legend.justification = c(1, 1), + legend.position = c(1, 1), + legend.title = element_blank()) + + ggtitle("GGPlot Example w/Hover") + + xlab("wt") + + ylab("mpg") + return(plot) +} + + +plot2ggplot_data <- function() { + return(mtcars) +} + + +plot3lattice <- function() { + plot <- xyplot(mpg ~ wt , data = mtcars, + pch = 1, groups = factor(cyl), + auto.key = list(corner = c(1, 1)), + main = "Lattice Example") + return(plot) +} + +plot3lattice_data <- function() { + return(mtcars) +} + + +plot_htmlwidget <- function(report_modus = FALSE) { + venn <- data.frame(A = 57, B = 12, C = 67, D = 72, AB = 4, + AC = 67, AD = 25, BC = 67, BD = 27, CD = 38, + ABC = 69, ABD = 28, ACD = 52, BCD = 46, ABCD = 3) + + htmlwidget <- canvasXpress(vennData = venn, + graphType = 'Venn', + vennGroups = 4, + vennLegend = list(A = "List1", B = "List2", C = "List3", D = "List4"), + title = "CanvasXpress Example", + disableToolbar = report_modus, + disableTouchToolbar = report_modus) + return(htmlwidget) +} diff --git a/tests/testthat/sample_app_no_sidebar/program/fxn/program_helpers.R b/tests/testthat/sample_app_no_sidebar/program/fxn/program_helpers.R new file mode 100644 index 0000000..209068e --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/fxn/program_helpers.R @@ -0,0 +1,29 @@ +library(dplyr) + +df <- read.csv("program/data/example.csv", + strip.white = T, + comment.char = "#") + + +load_data1 <- function() { + ldf <- df %>% + filter(substr(Geographic.Area, 1, 1) == ".") %>% + mutate(Geographic.Area = substring(Geographic.Area, 2)) + + as.data.frame(ldf) +} + + +load_data2 <- function() { + ldf <- df %>% + filter(substr(Geographic.Area, 1, 1) != ".") + + as.data.frame(ldf) +} + +load_data3 <- function() { + ldf <- df %>% + select(1:3) + + as.data.frame(ldf) +} diff --git a/tests/testthat/sample_app_no_sidebar/program/global.R b/tests/testthat/sample_app_no_sidebar/program/global.R new file mode 100644 index 0000000..52cfc13 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/global.R @@ -0,0 +1,26 @@ +# ---------------------------------------- +# -- PROGRAM global.R -- +# ---------------------------------------- +# USE: Global variables and functions +# +# NOTEs: +# - All variables/functions here are +# globally scoped and will be available +# to server, UI and session scopes +# ---------------------------------------- + +# -- IMPORTS -- +library(canvasXpress) + +# -- Setup your Application -- +set_app_parameters(title = "Sample Title (click for an info pop-up)", + titleinfo = HTML("

Application Information Pop-Up

", + "

This pop-up can contain any valid html + code.

If you prefer to have the title + link to any valid url location by providing + a character string to the titleinfo + parameter in set_app_parameters(...) + in program/global.R file.

"), + loglevel = "DEBUG", + app_version = "1.0.0") +# -- PROGRAM -- diff --git a/tests/testthat/sample_app_no_sidebar/program/server_global.R b/tests/testthat/sample_app_no_sidebar/program/server_global.R new file mode 100644 index 0000000..bcc8a3d --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/server_global.R @@ -0,0 +1,41 @@ +# ---------------------------------------- +# -- PROGRAM server_global.R -- +# ---------------------------------------- +# USE: Server-specific variables and +# functions for the main reactive +# shiny server functionality. All +# code in this file will be put into +# the framework outside the call to +# shinyServer(function(input, output, session) +# in server.R +# +# NOTEs: +# - All variables/functions here are +# SERVER scoped and are available +# across all user sessions, but not to +# the UI. +# +# - For user session-scoped items +# put var/fxns in server_local.R +# +# FRAMEWORK VARIABLES +# none +# ---------------------------------------- + +# -- IMPORTS -- + + +# -- VARIABLES -- +sg_example_data <- read.csv("program/data/example.csv", + comment.char = c("#"), + stringsAsFactors = F) + #note - since this is an example, the dataset provided is a reference + # dataset. This file is being read in server_global.R, where you + # should only load data that will be available to ALL users/sessions. + # ** IMPORTANT ** + # Do not read user-specific data in this file or global.R, use + # server-local.R for user-specific (i.e. session-specific) data! + +# -- FUNCTIONS -- + + diff --git a/tests/testthat/sample_app_no_sidebar/program/server_local.R b/tests/testthat/sample_app_no_sidebar/program/server_local.R new file mode 100644 index 0000000..f05680f --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/server_local.R @@ -0,0 +1,229 @@ +# ---------------------------------------- +# -- PROGRAM server_local.R -- +# ---------------------------------------- +# USE: Session-specific variables and +# functions for the main reactive +# shiny server functionality. All +# code in this file will be put into +# the framework inside the call to +# shinyServer(function(input, output, session) +# in server.R +# +# NOTEs: +# - All variables/functions here are +# SESSION scoped and are ONLY +# available to a single session and +# not to the UI +# +# - For globally scoped session items +# put var/fxns in server_global.R +# +# FRAMEWORK VARIABLES +# input, output, session - Shiny +# ss_userAction.Log - Reactive Logger S4 object +# ---------------------------------------- + +# -- IMPORTS -- + + +# -- VARIABLES -- + + +# -- FUNCTIONS -- +source(paste("program", "fxn", "program_helpers.R", sep = .Platform$file.sep)) +source(paste("program", "fxn", "plots.R", sep = .Platform$file.sep)) + + + +# ---------------------------------------- +# -- SHINY SERVER CODE -- +# ---------------------------------------- + +# -- Initialize UI Elements +output$proginfo <- renderUI({ + list(p("All program-specific (i.e. application-specific) code should be ", + "modified/added in the ", strong("program subfolder"), + " of the framework"), + hr(), + p("Sidebar elements are setup and registered to the framework in ", + "program/ui_sidebar.R"), + p("UI body boxes (such as this one) are registered to the framework ", + "in program/ui_body.R."), + p("Rendering handles and reactivity are programmed in ", + "program/server_local.R for session-specific functionality. If ", + "application-wide functionality is useful across all users that ", + "should be added into server_global.R. Scoping information is in ", + "the top comment of all program example files.") ) + }) + +output$tooltips <- renderUI({ + list(hr(), + p(ui_tooltip(id = "ex1", + label = "Tooltips", + text = "Example tooltip text"), + "can be added with the following code in the UI:"), + p(pre("U: ui_tooltip('tooltipID', 'label text (optional)', 'text content')")) ) + }) + +output$busyind <- renderUI({ + list(hr(), + p("There is an automatic wait indicator in the navbar when the shiny ", + "server session is busy."), + div(align = "center", + bsButton("showWorking", + label = "Show application busy indicator for 5 seconds", + style = "primary")) ) + }) + +output$download <- renderUI({ + list( + hr(), + p("Data download buttons for single-option (no choice of format) or ", + "multiple choices of formats can be added by specifying the ", + "extensions and corresponding data functions with the ", + "following code:"), + p(pre("U: downloadFileButton('uiID', list(extensions))"), + pre("S: callModule(downloadFile, 'uiID', logger, 'filenameroot', list(datafxns)"), + "Single Download: ", + downloadFileButton("exampleDownload1", c("csv"), "csv"), + "Multiple-choice Download: ", + downloadFileButton("exampleDownload2", + c("csv", "xlsx", "tsv"), "Download options")) ) + }) + +output$alerts <- renderUI({ + list(hr(), + p("There are three standardized locations for alerts. To create ", + "an alert call the following on the server: ", + pre('S: createAlert(session, location, content = "Alert Text", ...)'), + 'LOCATION can be: "sidebarBasicAlert", "sidebarAdvancedAlert", ', + 'and "bodyAlert". See the ', em("alertBS"), + "documentation for more information on styles and other options"), + div(align = "center", + bsButton( "exampleBasicAlert", + label = "Sidebar - Basic", + style = "success", + width = "25%"), + bsButton( "exampleAdvancedAlert", + label = "Sidebar - Advanced", + style = "warning", + width = "25%"), + bsButton( "exampleBodyAlert", + label = "Body", + style = "info", + append = FALSE, + width = "25%")) ) + }) + +output$loginfo <- renderUI({ + list(p("The collapsed ", + strong("User Action Log"), em("below"), + "is the standardized footer added by the framework.", + "To create actions to the framework call one of the logging ", + "functions like: ", + pre('logXXXX("Your Log Message with %s, %s parameters", parm1, parm2, logger = ss_userAction.Log)')), + p("The XXXX should be replaced by an actual log level like 'info', 'debug', 'warn' or 'error'. + The framework will handle updating the footer UI element every ", + "time the log is added to. It is important to note that the log ", + "rolls over for each session. The log files are kept in the ", + "/log directory and named 'actions.log'. ONE old copy of ", + "the log is kept as 'actions.log.last"), + p("See the ", em("logging"), "documentation for more information ", + "on functions and other options") ) + }) + +output$hover_info <- renderUI({ + hover <- input$examplePlot2_hover + point <- nearPoints(mtcars, hover, + xvar = "wt", yvar = "mpg", + maxpoints = 1) + if (nrow(point) == 0) { + return(NULL) + } + else { + left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left) + left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left) + + top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom) + top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top) + + style <- paste0("position:absolute;", + "z-index:100;", + "background-color: rgba(245, 245, 245, 0.85); ", + "left:", left_px + 2, "px; top:", top_px + 2, "px;") + + return(wellPanel(class = "well-sm", + style = style, + HTML(" Car: ", rownames(point))) ) + } +}) + +# -- CanvasXpress Plot Example + +output$examplePlot1 <- renderCanvasXpress({ + plot_htmlwidget() +}) + +loginfo("Be Sure to Remember to Log ALL user actions", + logger = ss_userAction.Log) + +# -- Setup Download Modules with Functions we want called +callModule(downloadFile, "exampleDownload1", ss_userAction.Log, + "examplesingle", + list(csv = load_data1)) +callModule(downloadFile, "exampleDownload2", ss_userAction.Log, + "examplemulti", + list(csv = load_data2, xlsx = load_data2, tsv = load_data2)) +callModule(downloadableTable, "exampleDT1", ss_userAction.Log, + "exampletable", + list(csv = load_data3, tsv = load_data3), + load_data3, + rownames = FALSE) + +callModule(downloadablePlot, "examplePlot2", ss_userAction.Log, + filenameroot = "plot2_ggplot", + downloadfxns = list(jpeg = plot2ggplot, + csv = plot2ggplot_data), + aspectratio = 1.5, + visibleplot = plot2ggplot) + +callModule(downloadablePlot, "examplePlot3", ss_userAction.Log, + filenameroot = "plot3_lattice", + aspectratio = 2, + downloadfxns = list(png = plot3lattice, + tiff = plot3lattice, + txt = plot3lattice_data, + tsv = plot3lattice_data), + visibleplot = plot3lattice) + +# -- Observe UI Changes +observeEvent(input$exampleBasicAlert, { + loginfo("Sidebar Basic Alert Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarBasicAlert", + style = "success", + content = "Example Basic Sidebar Alert") +}) + +observeEvent(input$exampleAdvancedAlert, { + loginfo("Sidebar Advanced Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "sidebarAdvancedAlert", + style = "warning", + content = "Example Advanced Sidebar Alert") + +}) + +observeEvent(input$exampleBodyAlert, { + loginfo("Body Alert Example Button Pushed", + logger = ss_userAction.Log) + createAlert(session, "bodyAlert", style = "info", append = FALSE, + content = paste("Example Body Alert - Append set to FALSE,", + "so only one alert will show")) +}) + +observeEvent(input$showWorking, { + loginfo("Show Busy Indicator Button Pushed", + logger = ss_userAction.Log) + Sys.sleep(5) +}) diff --git a/tests/testthat/sample_app_no_sidebar/program/ui_body.R b/tests/testthat/sample_app_no_sidebar/program/ui_body.R new file mode 100644 index 0000000..8a15e22 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/ui_body.R @@ -0,0 +1,93 @@ +# ---------------------------------------- +# -- PROGRAM ui_body.R -- +# ---------------------------------------- +# USE: Create UI elements for the +# application body (right side on the +# desktop; contains output) and +# ATTACH them to the UI by calling +# add_ui_body() +# +# NOTEs: +# - All variables/functions here are +# not available to the UI or Server +# scopes - this is isolated +# ---------------------------------------- + +# -- IMPORTS -- + + +# ---------------------------------------- +# -- BODY ELEMENT CREATION -- +# ---------------------------------------- + +# -- Create Elements +body1 <- shinydashboard::box( id = "bodyElement1", + title = "Code Specifics and Examples", + width = 8, + status = "primary", + collapsible = TRUE, + collapsed = TRUE, + htmlOutput("busyind"), + htmlOutput("tooltips"), + htmlOutput("alerts"), + htmlOutput("download")) + +body2 <- shinydashboard::box( id = "bodyElement2", + title = "Framework Information", + width = 4, + status = "success", + collapsible = TRUE, + collapsed = TRUE, + htmlOutput("proginfo") ) + +body3 <- shinydashboard::box( id = "bodyElement3", + title = "Downloadable Table", + width = 12, + status = "primary", + collapsible = TRUE, + collapsed = TRUE, + downloadableTableUI("exampleDT1", + list("csv", "tsv"), + "Download table data") ) + +body4 <- shinydashboard::box( id = "bodyElement4", + title = "CanvasXpress Plot", + width = 4, + status = "info", + collapsible = TRUE, + collapsed = FALSE, + canvasXpressOutput("examplePlot1")) + +plot2_hover <- hoverOpts(id = "examplePlot2_hover") + +body5 <- shinydashboard::box( id = "bodyElement5", + title = "downloadablePlots - ggplot2 & lattice", + width = 8, + status = "info", + collapsible = TRUE, + collapsed = FALSE, + fluidRow( + column(width = 6, downloadablePlotUI("examplePlot2", + list("jpeg", "csv"), + "Download plot or data", + btn_halign = "left", + btn_valign = "top", + btn_overlap = FALSE, + hoverOpts = plot2_hover)), + column(width = 6, downloadablePlotUI("examplePlot3", + list("png", "tiff", + "txt", "tsv"), + btn_overlap = FALSE, + "Download plot or data")) ), + uiOutput("hover_info") ) + +body6 <- shinydashboard::box( id = "bodyElement6", + title = "Logging Information", + width = 12, + status = "danger", + collapsible = FALSE, + htmlOutput("loginfo") ) + +# -- Register Elements in the ORDER SHOWN in the UI +# -- Note: Will be added before the standard framework footer +add_ui_body(list(body1, body2, body3, body4, body5, body6), append = FALSE) diff --git a/tests/testthat/sample_app_no_sidebar/program/ui_sidebar.R b/tests/testthat/sample_app_no_sidebar/program/ui_sidebar.R new file mode 100644 index 0000000..600b5b9 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/program/ui_sidebar.R @@ -0,0 +1,50 @@ +# ---------------------------------------- +# -- PROGRAM ui_sidebar.R -- +# ---------------------------------------- +# USE: Create UI elements for the +# application sidebar (left side on +# the desktop; contains options) and +# ATTACH them to the UI by calling +# add_ui_sidebar_basic() or +# add_ui_sidebar_advanced() +# +# NOTEs: +# - All variables/functions here are +# not available to the UI or Server +# scopes - this is isolated +# ---------------------------------------- + +# -- IMPORTS -- + + + +# ---------------------------------------- +# -- SIDEBAR ELEMENT CREATION -- +# ---------------------------------------- + +# -- Create Basic Elements +basictext <- div(style = "padding-top: 5px;", + helpText(align = "center", + "The BASIC tab is intended for commonly used ", + "options and settings for the application.")) + +# -- Register Basic Elements in the ORDER SHOWN in the UI +add_ui_sidebar_basic(list(basictext), append = FALSE) + + +# -- Create Advanced Elements +advancedtext <- div(style = "padding-top: 5px;", + helpText(align = "center", + style = "info", + "The ADVANCED tab is intended for less-commonly ", + "used options and settings for the application.")) + +resetinfo <- div(style = "padding-left: 5px;", + p("The reset functionality (button below) is a part of the ", + "framework and completely resets a user's session and ", + "rolls over their log. Nothing needs to be done by the ", + "program code for this to work.")) + + +# -- Register Advanced Elements in the ORDER SHOWN in the UI +add_ui_sidebar_advanced(list(advancedtext, resetinfo), append = FALSE) diff --git a/tests/testthat/sample_app_no_sidebar/server.R b/tests/testthat/sample_app_no_sidebar/server.R new file mode 100644 index 0000000..61e2b60 --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/server.R @@ -0,0 +1,28 @@ +# ------------------------------------------------- +# -- FRAMEWORK server.R -- +# ------------------------------------------------- +# NOTEs: -- +# Program code goes in "program" directory files -- +# ------------------------------------------------- +# ***** DO NOT EDIT THIS FILE ***** -- +# ------------------------------------------------- + +library(logging) + + +source(paste("program", "server_global.R", sep = .Platform$file.sep), + local = TRUE) + + +shinyServer(function(input, output, session) { + ss_userAction.Log <- periscope:::fw_get_user_log() + + source(paste("program", "server_local.R", sep = .Platform$file.sep), + local = TRUE) + + periscope:::fw_server_setup(input, output, session, ss_userAction.Log) + + loginfo("%s started with log level <%s>", + periscope:::fw_get_title(), periscope:::fw_get_loglevel(), + logger = ss_userAction.Log) +}) diff --git a/tests/testthat/sample_app_no_sidebar/ui.R b/tests/testthat/sample_app_no_sidebar/ui.R new file mode 100644 index 0000000..c0206da --- /dev/null +++ b/tests/testthat/sample_app_no_sidebar/ui.R @@ -0,0 +1,20 @@ +# ------------------------------------------------- +# -- FRAMEWORK ui.R -- +# ------------------------------------------------- +# NOTEs: -- +# Program code goes in "program" directory files -- +# ------------------------------------------------- +# ***** DO NOT EDIT THIS FILE ***** -- +# ------------------------------------------------- + +library(shinydashboard) + +periscope:::fw_reset_app_options() + +source(paste("program", "ui_body.R", sep = .Platform$file.sep), + local = TRUE) + + +dashboardPage(periscope:::fw_create_header(), + periscope:::fw_create_sidebar(showsidebar = FALSE), + periscope:::fw_create_body()) diff --git a/tests/testthat/sample_app_no_sidebar/www/img/loader.gif b/tests/testthat/sample_app_no_sidebar/www/img/loader.gif new file mode 100644 index 0000000000000000000000000000000000000000..a259e22f98737c00a56121fbd2eebba5e2d50556 GIT binary patch literal 2892 zcmd7U`#&4z9tUvkb}B(HTU#Qm)0QR@bgd$i>gCmg1Z|C0BB7_+5{X!AjNJ6LA`*Jl zNr<&YBoVctNQ7R{lEk{HlB;#CgT$?;HkAl^bg%O|XXnfxaGoEYU!Ldnyq@>#^L;L% zm=Hu@!g-suHg9a+w|DQ}q0#82e)Bu~L%~O)5A2T&-s$t%2P>AwHZOt?e3_V#k$B22 zi=TqqNc|rqCG9D{8sJdNepI<0*cc@E-0-}mBdS?fTRS(L z+a@3Wyr=cDnsmk`ey8eO`pJ0AkNR_C0hakJwQY9@t}3rt$n8czjgEOnD9{2R@)AY) zvE3#$h9`3dqwQJ{q#_-TG-pAwVPF;A6edS<^{^B@VU7{Gr26x|zvu70?KWAjNlAN_ zxVh=(Ywd*>>#tXQ?J8(E7B)csE`ZZWYY@V<3paLl=AyKRi-#VuJ1f&n4%@g#h`)*| z6K>&+{@dEH8q3^l+a1|pRux`zs*j@|+zfH9Kl@Di203ox!lS>bW5Bzhc* zqS_s|EaLtW;(W7P`G(UZ!%En!_eReb3e2<3gsQFOxSiQ^T;2yYg3i-ONi8w!i z_AuuV(TJoskSvfE6Pq-Eq+?%+LwF}B_b2+*!N%cF)@a*GzY$E(=)^yp0 zZ$z{^q~Po2d%W?mILNurf?ox!?g`w>sN3T6YASCxECn)>tQ`VuEbSdO0&WVRsXa-m` zF>e}bJkBBlp>%E_te-~?1(WeD7P?*dOVU2G*r-EFy7Z&TSb3CK4`;ZRwyKbk~o}ux1cR(}WM?Y^* z2)y+bJQ&^=u-!q3MhtE!gFwAJ3Hb zShw@}$Z4SyR;dcHU^`W8||6vem$(1^|3IE!X!gpYU($S;{Ylpdudi`@Zanx+`qk>w zE^Nv#hBe8K9*AIEPVQ(GwywK)mIz%HNOP2(;z`v4OO+9e2?XI0a}}Aoyg7gprVE=R zmmo`v6*!o4>9|s!Fm4oAvltjJVQGjxcKeZNwqgEQUL&<7S2u!z(PMN=QhAs@ z;5VL&JOxUyG9=*EO1+9>B5E zbz~oy+=W~Jz4gsS!Lgfj&g6tAm3{hn7(DXUOvYQZK!3t&S+%x;blgG@JsE9~nypSD zBcUP9L?Txh1KHQ@u68m#xrrlXA_SV3h_|3_AdV{Lk@A~AfEfd!z|cT)b*OT{E|50P zws(}XWKX!@IP21pWl+4f)P(o+;5#`iFAj2^&q*!)1Qd@P3~y=8z8n8^!MiNN`&8T5 z&%jUT##M;J_+_zwsN$u!jgi0B?l9nTrLm0HU$=UeT*rCX$b>_xZ*8;K-*xjn@znUx zgA`u*Xu$B7aL?mMHDAWu`$_mr^!gyPfScoYZ|EIgQxh*BOP-#a>0&JG^?x-R(w*C!rxAMC zJ~aC#1F}S1R*Z9~6Ew=!s%yOD8Zae+{c5CBZ!% zbe6Fc{7i~dM9;j%s|AY6Zb3Q3Pq^wz3z&kk)IqPQ!RR#^$CeH9!GH4t7QNfic84)b zyj<^t@br9b%-~5Y)>3)9j z=^rU4x%jb=Vbu1)KrG|MQ1zY{P2V^s&th%;`<;laETaYhoPmnbD~sFFVvC=`*(6g4 z*JU=x+Og>{ci31dZ)kjW<*4mHA+02~rYS0z%D^!|df}R9rbnud)IS cVuEA>uAf-H{QX(+C&vHb{}J{6zx#XpCopDIO8@`> literal 0 HcmV?d00001 diff --git a/tests/testthat/sample_app_no_sidebar/www/img/tooltip.png b/tests/testthat/sample_app_no_sidebar/www/img/tooltip.png new file mode 100644 index 0000000000000000000000000000000000000000..eb7eeb3b63fc3b3a002d6c5aff6e3313eaa3bd68 GIT binary patch literal 540231 zcmeI54{#kveaBb93AULe6ox=4xI)wcI>`EC%ZfC%NNOdq>)43Ip-vf0o~377#Fi9E z{+G1XGms%onxQykhX2!M23i7?jEialW}w7jC?T1`(8&bTNos~p2m>T!#wI59>zL;cY3 z;I96?d8H2hWyE0{2w3q z<~{em^^bPH`tXUL-}y52z57-_{KNMy?`a?Z-}buq{qfSm*P zd)E)I8-K&TPd{h`z1`d43l?=Ko|K7R4HZ`%99 zJ%9JY1K-cT<(cPx^W7)AfBmD~cd3()9C+$iU%2)g=U#kh|0|yQ)FL7l^-}ZAI(MdM|1Uu_U#=Q={&T) zVWQqn{XW>-)KEWh$mlKW8?Fi(tlz$+r+&lWaK656)!N41=C$qh?H#LH+S=RKw7gLAQ)tzgaJJ+<Hs$x` z_vHshM|8QCisgo;`t5Y_Sxrvwp0{DG$(AjZ3s1$nZ(qfxM@Fwcpb<jHqjMI3a!(*c5WEX z=SByIw+#;N?JD)MnN$DjN!s--YgRSazjaHlw|^jTg}1G13KyNxeWuoYcWyM_rTb-T zV@pe8YwNb=)tzmvx?eUnU(wmzTvkcx$WR?y2K)MV9iFOVZDVtLP)AF9XLDQUnl}A$ zx{k6V!*%HMs4q8~TU0IO$ClO8*W0;kaCl#Cw5xw#Zg;+EXkhocrkRapM^5*y&JBZm z2Zwc7`L33AO_erRETyfsr{uI<*AC|n*I%34w=Y-Ux~jFjjE7q*NqHkwgV_Qc)-?*k(+e2<=OIzdWTzkjPomaH2Ztf^4v1Lnn z@i|p@5BBa4PCZ?9$))-Rdv*0QxpnO9XkF9VvbM3Kc~`p@yuG8bV^>E@xRlIo72!chx@gO=Ju8y6Xent~1JGJdzJi z=JgFzXY;f_PTOBlX2KLYbG?C4cJ&75TE1^x)2yvCVNI8uEY@E^&P5?8)n8V8{x%No z$qz)Gqot}Qj+(!ck-=S~2Xn*ut9I)iQjLw2YM)&^+|0VB;1|r^{uBfm$sI^2$D+=z z7;?;Kcjo1o>D9e^as#{beO*mc9eQfR;uI|DI{QqUI(z4ynd^eze8E|*dsuGbY|_p; zXWLB6rQ^2;XXoDi6UVn}18Qz=Y6o0=#T-czyUP4kv4 z+cR0RBv#p|Z{ln$ZPjB+J)CWt9?#A>QKx;amTzWKs%5RAx@aT>B>E$`qWOgOf-3|h z`Xjia`God@D+DC^BeE$`qWOgOf-3|h`Xjia`God@ zD+DC^BeE$`qWOgOf-3|h`Xjia`God@D+DC^BeE$`qWOgOf-3|h`Xjia`God@D+DC^BeE$`qWOgOf-3|h`Xjia`God@D+DC^Bez}t5(pmV=LG=>cuD{R@KkuxhCo071E3#3z+(a! zfXCvKIs`BP`TztxCV&BWEIz4200W>8K)_=H7=Xv(lR5-20Qvv~JSKnvcq~4tLjVJy z4?w_U0vLeD;*&ZAFaY`h1Ux2y0eCDvsY3t*pbtR6V*(g}$KsPZ1TX;l00cZHfB|?c zKB+?h1E3E;z+(a!fXCvKIs`BP`TztxCV&BWEIz4200W>8K)_=H7=Xv(lR5-20Qvv~ zJSKnvcq~4tLjVJy4?w_U0vLeD;*&ZAFaY`h1Ux2y0eCDvsY3t*pbtR6V*(g}$KsPZ z1TX;l00cZHfB|?cKB+?h1E3E;z+(a!fXCvKIs`BP`TztxCV&BWEIz4200W>8K)_=H z7=Xv(lR5-20Qvv~JSKnvcq~4tLjVJy4?w_U0vLeD;*&ZAFaY`h1Ux2y0eCDvsY3t* zpbtR6V*(g}$KsPZ1TX;l00cZHfB|?cKB+?h1E3E;z+(a!fXCvKIs`BP`TztxCV&BW zEIz4200W>8K)_=H7=Xv(lR5-20Qvv~JSKnvcq~4tLjVJy4?w_U0vLeD;*&ZAFaY`h z1Ux2y0eCDvsY3t*pbtR6VghxA^J9s_#|082qyh-oO8^6~S34qyKw<(IKw^Yc00Dam zU;y@NN8}JlOaKE&jF1W-U@rj-z+UZ$90G|6U;v2`QUL_)C4d3gs~wR;ATa?9ATdHJ zfPlROFaUeCBXS5NCV&AXMo0w^u$KS^V6S#W4uQl3Fo47esQ?1@62JiL)sDy^keC1l zkQgBqK)_xC7=XRn5jg}B6IhbChJ+P-B4POyir1-S6Sdy2UOQd;y6Jbkv4g8L6BT#PHnSCi)K00->wh0rX{BihE z#x?>gRj`oWS@oDIO%2Z2mOyRe_16HFsnvRpf4|1bP`|c)%7)sOsbGo_ObvEuBX~?3 zf~PM(4PdkWoxetH_EdAyo+1!f|CjXt#P6~W8fI3yLf9tQFyv{$>5%}phfzA4t zK`<%Up`MoaO+mWS_;nw^I`yD>LJ$5*U-P9)mfGzi5KIc5(EY=+zTwXZV6(bL4cOHu zi8f;bFW27_d{KQ}9nH91gU$J204vnz81@_NWi~Y(Ob2e%cMLqFUbHFfxUsrF1qgRnK+d;f6=h0NrbpsgCL%N6gmfy?MI7!lV>P@=ed{Mc6emI@ra(&CkNBOcZ$$8*; z+0FXP!Q_8`Q#3?ZuK}#k-}K+lEk2_Ao(;jZs#aB}j;Y6O2sTcPZVqu)suTJK5AN`b z(<3MoCNQSQ0nXku=AHr6=~Mp%5A}q5F`p9iQ%{XG&n1?vKGA8nEzXqX97Z zx3Hr*9&&Icz{=-_?K1!d|BjzamZrDF&WV6+2EgFo((}WEu&ta3*ku3={yjL4EKbqF ziGWQ8z~JBFbHkI+gNeYEHsxxM0bIwGf15g%x3Mm>>-zwE4B#`|^Y86RWmn<{Y^KFWg=jM0bJtB;tQM{ z9ue4S$8)Ok4WLea#-naSs;&^|(f0;kBtIGH25_0a_J5sxj6?{5IRrMTd**Btw?VoA zbldx!l{l>lC~E>;^8ZYgYy+rg_Mdg1rM(&wSf&4z$fY%`FNLaP8^CdOc?vmGB?Ph} zutKfRs;PMGNH%~T^@s72q7($g5crDf5fe*=KqMQ$PU*v^3Ov~af!PF>DA8XCN;QDs z<{wMfSedOqpS&lqNpeq?Y5>8_KepVa?0pXhKqP?$#sG!lSY+`Gc1m@DPiBxiO+X+U z0zK+0*)&vrD>4mWg}So(R44%fu>{sj{ZdP!0a)-As@RT3U@{3@D)qJ&c?M9YEVzkE zW-lWu!34Txj%wu@z$G@^MlHCb5t>W_m+3DA1U}a;&j4<<;Xx{yeT=9?6F4AoWgBS* zaFH4kEh51|AU*+s-)%`VfO{mmWPHUb34t;KSE?0dpG3TsWdN)61;9EHTnGXJwI^_? zenhaT_SGh-QIY`!*Z)@~Nrtiz5Kdqv1~9)uT>qb+4SQT6aJj7S0wj$9xc=`-Cnt~j z3EVF0DwiY!*f&2l_CUZH0-u(Yi5vsCT%D5yhFBnw5`i@-)f=l?IR@|{^}1LYPzVBc z5m=_)B`07h2Czi^UJeu@fk27`Ua4+MvGyvfmSOk!2rx_Km@)L=rNx-24G$TB7lG~0vLcX^fU|s^8_#e^BNEV1dI{D0F0rhVF;Kf zfB~4-fCwO9i~t5;3_T4)z&rsAz`O=T00CnJFaTrdX&3_L319%`H6Q{A7$blI7(-9P z5HL>w12C@v5kSBg0Sv$xdK!j+c>)-Kc@2mF0>%hn0LIYMFa*pKzyQo^Km-slMgRja zhMtBYV4eU5U|s_vfPgUq7=SVKGzAyaq%70b>L(0AuKB7y{-AU;ySdAOZ*&BY*)ILr=pHFi!vjFs}g- zSWTc%9J4xp9Xu{zyMn|Ifdm9FfCTU;3IW>*U;wr&Nc<2;KmY?s0FR;&u$=$~V7r3E z4}k;(Fn|Q`C<+1F319%WD@gnhNI(DsNC1zb5U`y924K5_#1DZ41TcUE@F)ra+X-L* zwkt^d5J*4(14samq7bm100v;Yg2WGj1OzaE1n?*d0ow^+0JbYg{18Y$00T$>kD?H; zod5=4yMn|Ifdm9FfCTU;3IW>*U;wr&Nc<2;KmY?s0FR;&u$=$~V7r3E4}k;(Fn|Q` zC<+1F319%WD@gnhNI(DsNC1zb5U`y924K5_#1DZ41TcUE@F)ra+X-L*wkt^d5J*4( z14samq7bm100v;Yg2WGj1OzaE1n?*d0ow^+0JbYg{18Y$00T$>kD@*hC=|zBPZJk# zU19QrKm-8{AOa4%AmBOy48V1T$qxb%1TcUIIP8Le>jW?W*A*r|2t*LT03zV93j(ea zzyMrVnEW6RK>!1YfWs~bxK02Aa9v^YgFplU3?KpyyCC2?0Sv%(g~<;B5d<)R2srG5 zfa?S>0M`{JKL|t+zyKoPunPjN6TkpmSD5@D5J3O~h=9W`2)IrF18`ko@`FGG0Sq7l z4!a=WIspv8b%n_f0ucl-fCxD3f`ID;FaXyTCO-&75WoN;;IIne4bD$N_f z9aTom;Sg|zz;g46m^XkQnTJ3G5b%|Nc>`GLD|+&VfO!Ju4Zu7DB7lGy0vDQTw!Bpg zpqvKpJtR;ljv37QS@m;+txq;>-UTi)4}l0EV1U3e^)&;nhMF{Q03tAisPGX2=@Ss~ ztIxavh!_Z^uQn|}Kq3M22B4G(CzL1-F*!{@z^wpENicvHRncjoNe%*Y2|S|&+zcqg z0B%vI=kj3-1e_*tMhSQvK!yRFV+7!IS0}kj1TLwxG5c*2rT|JU%RX^hgn&^3JB_wJ z-M9<``2KV}yn%op1pY%tnlcPPh#Sg~gebfqAmTd!8P@=m5;7n1qT`XI1Oj5Nd&w99 z2)QCEp=S_-7X-w7^CiOoo>710h3q5=ff9kDlyAOd7=Th2s+Z^+5b%V+*VMmC$yAB~ zJfI$sf`m9AkTQW6)UzqKu;}Wg7{E(<48RKlJ`i|L{ga$Dr5J$HR{@@pgM~;SkQ#xr z>MN<$U3JBB4B#g`6Z700a(`=3&QX2rQn!v+DTb z56UV(2}zRPN;87%uSvFD1DvuI}%Y569i%tcwXvP+!75y>1(B5jg6Xu z5RgaUVW~H{$uxj-O4R+*^7<1ISw-MM^)9LL$}|9_?*=%+8bMM!ja_jSiZU*~e^zdX zmg)k(Qw5oqPVG7ah}Jj(;XPTZ0R*}U_D$p6iU4dOAbdb8*#HDjpKR%U#A%$sF5?kI z1|Zo0loERZHIgYiAuvVYw9H!oroxl*=YeM8nf*@eSE#eY`xyCA?KV zSUGsMLO?8mak+N@l{1rX07~CP@!9f_c@F{c1ir0qlza0}IXxQ;Ks2>wj{*Eve;;7Uu&QbmDBunO%ciUL7(h|48*a&k6?b|wnN&%@x(n9!7(k%Jxc*A8 zSfwN!4uPx)SooE-T?P<*AHYN)tL{uY)e$&r<4tR}8GvFUP+hO&=!^)wq$jAyGHR=a z&DduEOay8uKULL;Krr|puTfo@R%4?9FcHYKi_qAD1gsqVm$I_c0GJ3Y*e5w4GXjY8ZQR{8I z@?Vb0ZUbNWSrN?#%q(b0v{lHHlm6|iI)P4g9z7be2 z_3tlctR~H6LttFBxzgj7WJ4_VRtma>{c3sY?a+Yl1YT4RsqN~#D;QiD0hF{TsMoN3 zs4Lx4Y#yi8+uV8@#T^4s>Wsb}^N9R~n8kK(0$Yecu+INeZat6ck^uzEhZeL%rx((Z z{Sc^{Kv8Y8VV(bK^K#1og6vQ0OM)j^JE+=@!10j;f*XFm?BcH$_Y9z90XM3nk%F?* z83Ki3HtWSYaM#a#n!EBDR&wsb|J=M?odV2c8hn4#rtarX zp&2B+TadsJeUs_q3m)ab0qz?>aAokczE5bszEz;r0mVomZ32($lmAHCjYz5AKPH$E9akbW>7=$ZI>km*2$?%?UBpjVvGU-zByFMr<*AW-<2{_g_yH~QUQ z>z};*CU9PTP<_tdsiBVs5OnxpIuKaFay=U8R?C$s74<#irQiBqT38n_6S80L} zKCbjVLU`-!&#zR2vo|>OXnO2VhWQyDB#!l&5q3QO0vJF# zTwSQOsPFhY?m{BuFh2pN0Q0l)drvU<=k#~J4=@67UgB5@o@ekMi<@C+u8 ztI7les0x>(2eZl0SFYO#v!rJPmO`PR2?G#m(;A33yXYKqQbUG0vLeXU4cbD-PSj8c1!^h zBNSW#gMY!|$Ow%QfD9edh=Rd?8dM#tlM#Spf=;G$Ox>+cx|teT)sg@PP)nLp>SB>k zDN2ZsgDHS`iK-5eMLw%W=5GNEz%}hz%l5nu#RiHiJf4F2V7WJQFG0IZNH6yzCw+uwL- z8y_JMg8&8)1DfF?1@#(r+;9vu?+5{=0JaIqVn4PiCOTe50HWoY6C5jj&OyS4Bm@`% zB%zmeSyuYYnz-}rF#@nhVg~>AXk|^Li~#JAij_X?(8;T3FHaL^BVq&~OIjBBl%3Se4#=hyiu6vs?6ru}FF33?RS0#kRCc}t`z}B0JS1nT|KPySsgEqPKf{pkP_I)YFX?j z5)V7GBfu0OJJwSzvC`)h34R(UfB|GJ0V{oGO`P^32rvbRfRn;52LCBQrONmO7y-m* zS8YjF`mB~1$EQw!5kTsQCmUd~pR7pJP89?g0aO7i!J(}5nE)O|(<6WZq{nuqW>)%~ zVZl351egM(DMxXlat8ltGN$fC1Q-D%!nZ)-W$HzBQmt2~7dVdH5HLgl14t8mo%+0b zFQ>0Xqp`0Cws|)DWl%0Surf7^wsTb`rnW5(wBy00Xd7H=>3>O$cBBHNi+F5U`T~ z24JUdL=AzO5WoOxg3;$n3dJ#>({~|vT)+ht$pHc}319#*!BGqXE)c)~Tu_l5AP|!P z1`rb*#US7U0Sv$e70CetF$rJ*F~Ly`0xl5109;U!93T*r00s~f9K|5u0s#!b1r^Bw z0x=0-05QQ)3<53?zyMrOksKfplK=(~6CA}L-~s^*zy%e_0Rk}zU;r_}Q49hu5WoOj zP>~!U5R(7~5EC55Am9Q448R2y$pHc}319#*!BGqXE)c)~Tu_l5AP|!P1`rb*#US7U z0Sv$e70CetF$rJ*F~Ly`0xl5109;U!93T*r00s~f9K|5u0s#!b1r^Bw0x=0-05QQ) z3<53?zyMrOksKfplK=(~6CA}L-~s^*zy%e_0Rk}zU;r_}Q49hu5WoOjP>~!U5R(7~ z5EGm~#R|nSf0FexQ(VAL-N_mP69g~-IsybdCV&BWEIz4200W>8K)_=H7=Xv(lR5-2 z0Qvv~JSKnvcq~4tLjVJy4?w_U0vLeD;*&ZAFaY`h1Ux2y0eCDvsY3t*pbtR6V*(g} z$KsPZ1TX;l00cZHfB|?cKB+?h1E3E;z+(a!fXCvKIs`BP`TztxCV&BWEIz4200W>8 zK)_=H7=Xv(lR5-20Qvv~JSKnvcq~4tLjVJy4?w_U0vLeD;*&ZAFaY`h1Ux2y0eCDv zsY3t*pbtR6V*(g}$KsPZ1TX;l00cZHfB|?cKB+?h1Mt2NTu}T!?->A~Sgcd3SUj-e X=;7Y3o<{>9o37s4{V#uZ^9TMPcrJU> literal 0 HcmV?d00001 diff --git a/tests/testthat/test_convert_application.R b/tests/testthat/test_convert_application.R index 5f0fd08..2170860 100644 --- a/tests/testthat/test_convert_application.R +++ b/tests/testthat/test_convert_application.R @@ -1,7 +1,7 @@ context("periscope convert existing application") -expect_converted_application <- function(location, right_sidebar = NULL, reset_button = NULL) { +expect_converted_application <- function(location, right_sidebar = NULL, reset_button = NULL, left_sidebar = NULL) { expect_true(dir.exists(location)) expect_true(file.exists(file.path(location, "global.R"))) expect_true(file.exists(file.path(location, "server.R"))) @@ -27,18 +27,62 @@ expect_converted_application <- function(location, right_sidebar = NULL, reset_b expect_true(any(grepl("resetbutton", ui_content))) } } + if (!is.null(left_sidebar)) { + if (left_sidebar) { + expect_true(file.exists(file.path(location, "program", "ui_sidebar.R"))) + } else { + expect_true(!file.exists(file.path(location, "program", "ui_sidebar.R"))) + } + + } # clean up unlink(location, TRUE) } # creates a temp directory, copies the sample_app to this directory and returns the path of the temp app -create_app_tmp_dir <- function() { - app_name <- "sample_app" +create_app_tmp_dir <- function(left_sidebar = TRUE) { + app_name <- ifelse(left_sidebar, "sample_app", "sample_app_no_sidebar") app_temp.dir <- tempdir() file.copy(app_name, app_temp.dir, recursive = TRUE) file.path(app_temp.dir, app_name) } +## left_sidebar tests + +test_that("add_left_sidebar null location", { + expect_warning(add_left_sidebar(location = NULL), + "Add left sidebar conversion could not proceed, location cannot be empty!") +}) + +test_that("add_left_sidebar empty location", { + expect_warning(add_left_sidebar(location = ""), + "Add left sidebar conversion could not proceed, location cannot be empty!") +}) + +test_that("add_left_sidebar invalid location", { + expect_warning(add_left_sidebar(location = "invalid"), + "Add left sidebar conversion could not proceed, location= does not exist!") +}) + +test_that("add_left_sidebar location does not contain an existing application", { + expect_warning(add_left_sidebar(location = "../testthat"), + "Add left sidebar conversion could not proceed, location=<../testthat> does not contain a valid periscope application!") +}) + +test_that("add_left_sidebar valid location", { + app_location <- create_app_tmp_dir(left_sidebar = FALSE) + + expect_message(add_left_sidebar(location = app_location), "Add left sidebar conversion was successful. File\\(s\\) updated: ui.R") + expect_converted_application(location = app_location, left_sidebar = TRUE) +}) + +test_that("add_left_sidebar valid location, added twice", { + app_location <- create_app_tmp_dir(left_sidebar = FALSE) + + expect_message(add_left_sidebar(location = app_location), "Add left sidebar conversion was successful. File\\(s\\) updated: ui.R") + expect_message(add_left_sidebar(location = app_location), "Left sidebar already available, no conversion needed") + expect_converted_application(location = app_location, left_sidebar = TRUE) +}) ## add_right_sidebar tests diff --git a/tests/testthat/test_create_new_application.R b/tests/testthat/test_create_new_application.R index 2822fd0..aa825b9 100755 --- a/tests/testthat/test_create_new_application.R +++ b/tests/testthat/test_create_new_application.R @@ -1,7 +1,7 @@ context("periscope create new application") -expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, dashboard_plus = FALSE) { +expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, dashboard_plus = FALSE, leftsidebar = TRUE) { expect_true(dir.exists(fullname)) expect_true(file.exists(paste0(fullname, "/global.R"))) expect_true(file.exists(paste0(fullname, "/server.R"))) @@ -17,11 +17,16 @@ expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, d expect_true(file.exists(paste0(fullname, "/program/server_global.R"))) expect_true(file.exists(paste0(fullname, "/program/server_local.R"))) expect_true(file.exists(paste0(fullname, "/program/ui_body.R"))) - expect_true(file.exists(paste0(fullname, "/program/ui_sidebar.R"))) expect_true(dir.exists(paste0(fullname, "/program/data"))) expect_true(dir.exists(paste0(fullname, "/program/fxn"))) expect_true(dir.exists(paste0(fullname, "/log"))) + if (leftsidebar) { + expect_true(file.exists(paste0(fullname, "/program/ui_sidebar.R"))) + } else { + expect_true(!file.exists(paste0(fullname, "/program/ui_sidebar.R"))) + } + if (sampleapp) { expect_true(file.exists(paste0(fullname, "/program/data/example.csv"))) expect_true(file.exists(paste0(fullname, "/program/fxn/program_helpers.R"))) @@ -68,6 +73,16 @@ test_that("create_new_application sample right_sidebar", { expect_cleanup_create_new_application(appTemp, sampleapp = TRUE, dashboard_plus = !is.null(right_sidebar)) }) +test_that("create_new_application no left sidebar", { + appTemp.dir <- tempdir() + appTemp <- tempfile(pattern = "TestThatApp", tmpdir = appTemp.dir) + appTemp.name <- gsub('\\\\|/', '', (gsub(appTemp.dir, "", appTemp, fixed = T))) + + expect_message(create_new_application(name = appTemp.name, location = appTemp.dir, leftsidebar = FALSE), + "Framework creation was successful.") + expect_cleanup_create_new_application(appTemp, leftsidebar = FALSE) +}) + test_that("create_new_application no reset button", { appTemp.dir <- tempdir() appTemp <- tempfile(pattern = "TestThatApp", tmpdir = appTemp.dir) diff --git a/tests/testthat/test_ui_functions.R b/tests/testthat/test_ui_functions.R index 5162bcf..3ff0f4c 100755 --- a/tests/testthat/test_ui_functions.R +++ b/tests/testthat/test_ui_functions.R @@ -20,20 +20,32 @@ test_that("fw_create_header", { expect_equal(result.children[[2]]$children[[1]]$children[[1]], "Working") }) -check_sidebar_result <- function(result, basic_existing = FALSE, advanced_existing = FALSE) { +check_sidebar_result <- function(result, showsidebar = TRUE, basic_existing = FALSE, advanced_existing = FALSE) { expect_equal(result$name, "aside") if (length(result$attribs) == 2) { expect_equal(result$attribs, list(class = "main-sidebar", 'data-collapsed' = "false")) } else { - expect_equal(result$attribs, list(id = "sidebarCollapsed", class = "main-sidebar", 'data-collapsed' = "false")) + if (showsidebar) { + expect_equal(result$attribs, list(id = "sidebarCollapsed", class = "main-sidebar", 'data-collapsed' = "false")) + } else { + expect_equal(result$attribs, list(id = "sidebarCollapsed", class = "main-sidebar", 'data-collapsed' = "true")) + } } result.children <- result$children expect_equal(length(result.children), 2) - expect_equal(result.children[[1]], NULL) ## ? + if (showsidebar) { + expect_equal(result.children[[1]], NULL) ## ? + } else { + expect_equal(length(result.children[[1]]), 3) + expect_equal(result.children[[1]][[1]], "head") + expect_equal(class(result.children[[1]][[2]]), "list") + expect_equal(class(result.children[[1]][[3]]), "list") + } expect_equal(result.children[[2]]$name, "section") expect_equal(result.children[[2]]$attribs$class, "sidebar") + expect_equal(result.children[[2]][[2]]$id, "sidebarItemExpanded") result.subchilds <- result.children[[2]]$children[[1]] expect_equal(length(result.subchilds), 3) @@ -52,10 +64,16 @@ check_sidebar_result <- function(result, basic_existing = FALSE, advanced_existi } } +test_that("fw_create_sidebar no sidebar", { + result <- periscope:::fw_create_sidebar(showsidebar = F, resetbutton = F) + + check_sidebar_result(result, showsidebar = FALSE) +}) + test_that("fw_create_sidebar empty", { - result <- periscope:::fw_create_sidebar() + result <- periscope:::fw_create_sidebar(showsidebar = T, resetbutton = F) - check_sidebar_result(result) + check_sidebar_result(result, showsidebar = TRUE) }) test_that("fw_create_sidebar only basic", { @@ -64,11 +82,11 @@ test_that("fw_create_sidebar only basic", { .g_opts$side_basic <- list(tags$p()) side_advanced <- shiny::isolate(.g_opts$side_advanced) .g_opts$side_advanced <- NULL - - result <- periscope:::fw_create_sidebar() - - check_sidebar_result(result, basic_existing = TRUE) - + + result <- periscope:::fw_create_sidebar(showsidebar = T, resetbutton = F) + + check_sidebar_result(result, showsidebar = TRUE, basic_existing = TRUE, advanced_existing = FALSE) + # teardown .g_opts$side_basic <- side_basic .g_opts$side_advanced <- side_advanced @@ -82,8 +100,8 @@ test_that("fw_create_sidebar only advanced", { .g_opts$side_advanced <- list(tags$p()) result <- periscope:::fw_create_sidebar() - - check_sidebar_result(result, basic_existing = TRUE) + + check_sidebar_result(result, showsidebar = TRUE, basic_existing = FALSE, advanced_existing = TRUE) # teardown .g_opts$side_basic <- side_basic @@ -99,7 +117,7 @@ test_that("fw_create_sidebar basic and advanced", { result <- periscope:::fw_create_sidebar() - check_sidebar_result(result, basic_existing = TRUE, advanced_existing = TRUE) + check_sidebar_result(result, showsidebar = TRUE, basic_existing = TRUE, advanced_existing = TRUE) # teardown .g_opts$side_basic <- side_basic @@ -241,66 +259,66 @@ test_that("fw_create_header_plus", { result <- periscope:::fw_create_header_plus() expect_equal(result$name, "header") expect_equal(result$attribs, list(class = "main-header")) - + result.children <- result$children expect_equal(length(result.children), 3) expect_equal(result.children[[1]], NULL) ## ? - + expect_equal(result.children[[2]]$name, "span") expect_equal(result.children[[2]]$attribs$class, "logo") expect_equal(length(result.children[[2]]$children), 1) - + expect_equal(result.children[[2]]$children[[1]]$name, "div") expect_equal(result.children[[2]]$children[[1]]$attribs, list(class = "periscope-busy-ind")) - + expect_equal(length(result.children[[2]]$children[[1]]$children), 2) expect_equal(result.children[[2]]$children[[1]]$children[[1]], "Working") - + expect_equal(result.children[[3]]$name, "nav") expect_equal(result.children[[3]]$attribs$class, "navbar navbar-static-top") expect_equal(length(result.children[[3]]$children), 4) - + expect_equal(result.children[[3]]$children[[1]]$name, "span") expect_equal(result.children[[3]]$children[[1]]$attribs, list(style = "display:none;")) - + expect_equal(result.children[[3]]$children[[2]]$name, "a") expect_equal(result.children[[3]]$children[[2]]$attribs, list(href = "#", class = "sidebar-toggle", `data-toggle` = "offcanvas", role = "button")) - + expect_equal(result.children[[3]]$children[[3]]$name, "div") expect_equal(result.children[[3]]$children[[3]]$attribs, list(class = "navbar-custom-menu", style = "float: left; margin-left: 10px;")) - + expect_equal(result.children[[3]]$children[[4]]$name, "div") expect_equal(result.children[[3]]$children[[4]]$attribs, list(class = "navbar-custom-menu")) }) test_that("fw_create_right_sidebar", { result <- periscope:::fw_create_right_sidebar() - + expect_equal(length(result), 2) expect_equal(result[[1]]$name, "head") expect_equal(length(result[[1]]$attribs), 0) expect_equal(length(result[[1]]$children), 1) - + result1.children <- result[[1]]$children[[1]] - + expect_equal(result1.children$name, "style") expect_equal(length(result1.children$attribs), 0) - + expect_equal(result[[2]]$name, "div") expect_equal(result[[2]]$attribs, list(id = "controlbar")) expect_equal(length(result[[2]]$children), 2) - + result2.children <- result[[2]]$children - + expect_equal(result2.children[[1]]$name, "aside") expect_equal(length(result2.children[[1]]$children), 2) - + expect_equal(result2.children[[1]]$children[[1]]$name, "ul") expect_equal(result2.children[[1]]$children[[1]]$attribs, list(class = "nav nav-tabs nav-justified control-sidebar-tabs")) - + expect_equal(result2.children[[1]]$children[[2]]$name, "div") expect_equal(result2.children[[1]]$children[[2]]$attribs, list(class = "controlbar tab-content")) - + expect_equal(result2.children[[2]]$name, "div") expect_equal(result2.children[[2]]$attribs, list(class = "control-sidebar-bg", style = "width: 230px;")) }) diff --git a/vignettes/new-application.Rmd b/vignettes/new-application.Rmd index 3fbc5b0..658268d 100755 --- a/vignettes/new-application.Rmd +++ b/vignettes/new-application.Rmd @@ -47,7 +47,7 @@ are missing there will be no tabs shown (the sidebar will not have tabbed areas) The left sidebar can be collapsed in desktop mode to maximize the user's view of the application body when they do not immediately need the configuration options and -settings. +settings. Also, it is possible to create an application without a left sidebar. *2: Body* @@ -184,6 +184,8 @@ library(periscope) app_dir = tempdir() create_new_application(name = 'mytestapp', location = app_dir, sampleapp = TRUE) +# application without a left sidebar +create_new_application(name = 'mytestapp', location = app_dir, sampleapp = TRUE, leftsidebar = FALSE) # application without a reset button create_new_application(name = 'mytestapp', location = app_dir, sampleapp = TRUE, resetbutton = FALSE) # application with a right sidebar using the default icon @@ -192,7 +194,7 @@ create_new_application(name = 'mytestapp', location = app_dir, sampleapp = TRUE, create_new_application(name = 'mytestapp', location = app_dir, sampleapp = TRUE, rightsidebar = "table") ``` -This generates a default sample application optionally with a right sidebar in a subdirectory named *mytestapp* +This generates a default sample application optionally with a left/right sidebar in a subdirectory named *mytestapp* at the specified location. The location must exist when calling this function. *Note*: If the *mytestapp* directory in this location already exists it will not @@ -220,6 +222,8 @@ library(periscope) app_dir = tempdir() create_new_application(name = 'mytestapp', location = app_dir) +# application without a left sidebar +create_new_application(name = 'mytestapp', location = app_dir, leftsidebar = FALSE) # application without a reset button create_new_application(name = 'mytestapp', location = app_dir, resetbutton = FALSE) # application with a right sidebar using the default icon @@ -228,7 +232,7 @@ create_new_application(name = 'mytestapp', location = app_dir, rightsidebar = TR create_new_application(name = 'mytestapp', location = app_dir, rightsidebar = "table") ``` -This generates a default blank application optionally with a right sidebar in a subdirectory named *mytestapp* +This generates a default blank application optionally with a left/right sidebar in a subdirectory named *mytestapp* at the specified location. The location must exist when calling this function. *Note*: If the *mytestapp* directory in this location already exists it will not