Add d tdatatable options support

DESCRIPTION

@@ -31,7 +31,6 @@ Imports:
     utils,
     fresh,
     yaml,
-    htmlwidgets,
     grDevices
 RoxygenNote: 7.1.1
 Suggests:

R/downloadableTable.R

@@ -124,7 +124,7 @@ downloadableTableUI <- function(id,
 #'   the button will be hidden as there is nothing to download.
 #'   \item \code{selection} parameter has different usage than DT::datatable \code{selection} option. 
 #'   See parameters usage section.
-#'   \item DT::datatable option \code{editable} is not supported
+#'   \item DT::datatable options \code{editable}, \code{width} and \code{height} are not supported
 #' }
 #'
 #' @section Shiny Usage:
@@ -253,11 +253,6 @@ download_table <- function(input, output, session,
         selection <- NULL
     }
 
-    if (!is.null(table_options[["editable"]])) {
-        message("'editable' DT parameter is not supported. Ignoring it.")
-        table_options[["editable"]] <- NULL
-    }
-
     downloadFile("dtableButtonID", logger, filenameroot, downloaddatafxns)
 
     session$sendCustomMessage("downloadbutton_toggle",
@@ -361,21 +356,21 @@ download_table <- function(input, output, session,
 }
 
 build_datatable_arguments <- function(table_options) {
-    if (!is.null(table_options[["editable"]]) && table_options[["editable"]]) {
-        message(paste("'editable' option is enabled.",
-                      "Please note that it needs server logic to save any dataset change",
-                      "Please Refer to DT package documentation for more information about using that parameter."))
-    }
     dt_args <- list()
     formal_dt_args <- methods::formalArgs(DT::datatable)
     dt_args[["rownames"]] <- TRUE
     dt_args[["class"]] <- paste("periscope-downloadable-table table-condensed",
                                "table-striped table-responsive")
     options <- list()
     for (option in names(table_options)) {
+        if (option %in% c("editable", "width", "height")) {
+            message("DT option '", option ,"' is not supported. Ignoring it.")
+            next
+        }
+
         if (option %in% formal_dt_args) {
             dt_args[[option]] <- table_options[[option]]
-        } else{
+        } else {
             options[[option]] <- table_options[[option]]
         }
     }
@@ -407,7 +402,6 @@ build_datatable_arguments <- function(table_options) {
     if (is.null(options[["searchHighlight"]])) {
         options[["searchHighlight"]] <- TRUE
     }
-    dt_args[["callback"]] <- htmlwidgets::JS(dt_args[["callback"]])
     dt_args[["options"]] <- options
     dt_args
 }

R/fw_helpers_internal.R

@@ -69,8 +69,7 @@
 }
 
 .remove_sidebar_toggle <- function() {
-    shiny::tags$script(shiny::HTML("$('[class~=\"sidebar-toggle\"]').remove();
-                                    $('[class~=\"logo\"]').css('background-color', '#3c8dbc');"))
+    shiny::tags$script(shiny::HTML("$('[class~=\"sidebar-toggle\"]').remove();"))
 }
 
 # Returns the custom css as HTML

R/generate_template.R

@@ -16,7 +16,6 @@
 #' @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.
-#' @param style list containing application styling properties. By default the skin is blue.
 #' @param custom_theme_file location of custom theme settings yaml file. Default value is NULL.
 #'
 #' @section Name:
@@ -109,7 +108,7 @@
 #' # blank app named 'myblankapp' created in a temp dir
 #' create_new_application(name = 'myblankapp', location = tempdir())
 #' # blank app named 'myblankapp' with a green skin created in a temp dir
-#' create_new_application(name = 'myblankapp', location = tempdir(), style = list(skin = "green"))
+#' 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)
 #'
@@ -120,7 +119,6 @@ create_new_application <- function(name,
                                    resetbutton = TRUE,
                                    rightsidebar = FALSE, 
                                    leftsidebar = TRUE, 
-                                   style = list(skin = "blue"),
                                    custom_theme_file = NULL) {
     usersep <- .Platform$file.sep
     newloc <- paste(location, name, sep = usersep)
@@ -146,15 +144,6 @@ create_new_application <- function(name,
                 stop("Framework creation could not proceed, invalid type for rightsidebar, only logical or character allowed")
             }
         }
-        if (!is.null(style)) {
-            if (class(style) == "list") {
-                if (!identical(intersect("skin", names(style)), character(0)) && !identical(class(style$skin), "character")) {
-                    stop("Framework creation could not proceed, invalid type for skin, only character allowed. See ?shinydashboard::dashboardPage for supported colors.")  
-                }
-            } else {
-                stop("Framework creation could not proceed, invalid type for style, only list allowed")  
-            }
-        }
 
         if (!(.g_sdp_installed) && dashboard_plus) {
             stop('shinyDashboardPlus is not currently installed -- it is required to generate an application with a right sidebar.')
@@ -170,7 +159,7 @@ create_new_application <- function(name,
                 custom_theme_file <- NULL
             }
         }
-        .copy_fw_files(newloc, usersep, resetbutton, dashboard_plus, leftsidebar, right_sidebar_icon, style, custom_theme_file)
+        .copy_fw_files(newloc, usersep, resetbutton, dashboard_plus, leftsidebar, right_sidebar_icon, custom_theme_file)
         .copy_program_files(newloc, usersep, sampleapp, resetbutton, leftsidebar, dashboard_plus)
 
         message("Framework creation was successful.")
@@ -208,7 +197,6 @@ create_new_application <- function(name,
                            dashboard_plus = FALSE,
                            leftsidebar = TRUE, 
                            right_sidebar_icon = NULL,
-                           style = list(skin = "blue"),
                            custom_theme_file) {
     files <- c("global.R",
                "server.R")
@@ -257,19 +245,7 @@ create_new_application <- function(name,
         writeLines(ui_content, con = ui_file)
         close(ui_file)
     }
-    # styling
-    if (!is.null(style) && identical(class(style), "list") && length(style) > 0 &&
-        !identical(intersect("skin", names(style)), character(0)) && !identical(style, list(skin = "blue"))) {
-        skin_value  <- style$skin
-        ui_file     <- file(paste(newloc, "ui.R", sep = usersep), open = "r+")
-        ui_content  <- readLines(con = ui_file)
-        ui_content[length(ui_content)]     <- paste0(substr(ui_content[length(ui_content)], 1, nchar(ui_content[length(ui_content)]) - 1), ",")
-        white_space <- paste(rep(" ", ifelse(dashboard_plus, nchar("dashboardPagePlus"), nchar("dashboardPage"))), collapse = "")
-        ui_content[length(ui_content) + 1] <- sprintf("%s skin = '%s')", white_space, skin_value)
-        writeLines(ui_content, con = ui_file)
-        close(ui_file)
-    }
-
+
     #subdir copies
     imgs <- c("loader.gif", "tooltip.png")
     for (file in imgs) {

README.md

@@ -64,12 +64,3 @@ create_new_application("sampleapp2", location = tempdir(), sampleapp = TRUE, rig
 runApp('sampleapp2')
 
 ```
-
-#### Sample application - custom styling
-
-```r
-library(periscope)
-create_new_application("sampleapp3", location = tempdir(), sampleapp = TRUE, style = list(skin = "green"))
-runApp('sampleapp3')
-
-```

tests/testthat/_snaps/downloadable_table.md

@@ -25,7 +25,9 @@
     Code
       build_datatable_arguments(table_options)
     Message <simpleMessage>
-      'editable' option is enabled. Please note that it needs server logic to save any dataset change Please Refer to DT package documentation for more information about using that parameter.
+      DT option 'width' is not supported. Ignoring it.
+      DT option 'height' is not supported. Ignoring it.
+      DT option 'editable' is not supported. Ignoring it.
     Output
       $rownames
       [1] FALSE
@@ -35,8 +37,6 @@
 
       $callback
       [1] "table.order([2, 'asc']).draw();"
-      attr(,"class")
-      [1] "JS_EVAL"
 
       $caption
       [1] " Very Important Information"
@@ -47,21 +47,12 @@
       $filter
       [1] "bottom"
 
-      $width
-      [1] "150px"
-
-      $height
-      [1] "50px"
-
       $extensions
       [1] "Buttons"
 
       $plugins
       [1] "natural"
 
-      $editable
-      [1] TRUE
-
       $options
       $options$order
       $options$order[[1]]

tests/testthat/_snaps/ui_functions.md

@@ -25,8 +25,7 @@
     <aside id="sidebarCollapsed" class="main-sidebar" data-collapsed="true">
       <section id="sidebarItemExpanded" class="sidebar">
         <script>$("<div class='periscope-title'> Set using set_app_parameters() in program/global.R </div>").insertAfter($("a.sidebar-toggle"));</script>
-        <script>$('[class~="sidebar-toggle"]').remove();
-                                        $('[class~="logo"]').css('background-color', '#3c8dbc');</script>
+        <script>$('[class~="sidebar-toggle"]').remove();</script>
       </section>
     </aside>
 

tests/testthat/test_app_reset.R

@@ -51,7 +51,15 @@ test_that(".appReset", {
                                input = list(),
                                output = list(), 
                                session = MockShinySession$new(),
-                               logger = periscope:::fw_get_user_log())
+                               periscope:::fw_get_user_log())
     expect_equal(class(reset)[[1]], "Observer")
     expect_equal(class(reset)[[2]], "R6")
 })
+
+test_that(".appReset - new call", {
+    expect_error(.appReset("reset", 
+                           input = list(),
+                           output = list(), 
+                           session = MockShinySession$new(),
+                           logger = periscope:::fw_get_user_log()))
+})

tests/testthat/test_create_new_application.R

@@ -1,14 +1,15 @@
 context("periscope create new application")
 
-
-expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, dashboard_plus = FALSE, leftsidebar = TRUE, skin = NULL) {
+expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, dashboard_plus = FALSE, leftsidebar = TRUE) {
+    local_edition(3)
     expect_true(dir.exists(fullname))
     expect_true(file.exists(paste0(fullname, "/global.R")))
     expect_true(file.exists(paste0(fullname, "/server.R")))
     expect_true(file.exists(paste0(fullname, "/ui.R")))
     expect_true(dir.exists(paste0(fullname, "/www")))
     expect_true(dir.exists(paste0(fullname, "/www/css")))
     expect_true(dir.exists(paste0(fullname, "/www/js")))
+    expect_true(file.exists(paste0(fullname, "/www/periscope_style.yaml")))
     expect_true(dir.exists(paste0(fullname, "/www/img")))
     expect_true(file.exists(paste0(fullname, "/www/img/loader.gif")))
     expect_true(file.exists(paste0(fullname, "/www/img/tooltip.png")))
@@ -37,13 +38,6 @@ expect_cleanup_create_new_application <- function(fullname, sampleapp = FALSE, d
     } else {
         expect_true(!file.exists(paste0(fullname, "/program/ui_sidebar_right.R")))
     }
-    if (!is.null(skin)) {
-        ui_file    <- file(paste0(fullname, "/ui.R"), open = "r")
-        ui_content <- readLines(con = ui_file)
-        close(ui_file)
-        expect_true(any(grepl(skin, ui_content)))
-    }
-
     # clean up
     unlink(fullname, TRUE)
 }
@@ -141,43 +135,26 @@ test_that("create_new_application no reset button, no left sidebar", {
     expect_cleanup_create_new_application(appTemp, sampleapp = TRUE, leftsidebar = FALSE)
 })
 
-test_that("create_new_application custom style", {
-    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, sampleapp = FALSE, rightsidebar = NULL, style = list(skin = "green")), 
-                   "Framework creation was successful.")
-    expect_cleanup_create_new_application(appTemp, skin = "green")
-})
 
-test_that("create_new_application bad style", {
+test_that("create_new_application invalid yaml file", {
     appTemp.dir  <- tempdir()
     appTemp      <- tempfile(pattern = "TestThatApp", tmpdir = appTemp.dir)
     appTemp.name <- gsub('\\\\|/', '', (gsub(appTemp.dir, "", appTemp, fixed = T)))
 
-    expect_error(create_new_application(name = appTemp.name, location = appTemp.dir, sampleapp = FALSE, rightsidebar = NULL, style = list("green")), 
-                   "Framework creation could not proceed, invalid type for skin, only character allowed")
+    expect_warning(create_new_application(name = appTemp.name, location = appTemp.dir, sampleapp = FALSE, rightsidebar = NULL, custom_theme_file = ""), 
+                   "'custom_theme_file' must be single character value pointing to valid yaml file location. Using default values.")
 })
 
-test_that("create_new_application custom style right sidebar", {
+test_that("create_new_application with valid yaml file", {
     appTemp.dir  <- tempdir()
     appTemp      <- tempfile(pattern = "TestThatApp", tmpdir = appTemp.dir)
     appTemp.name <- gsub('\\\\|/', '', (gsub(appTemp.dir, "", appTemp, fixed = T)))
+    yaml_loc     <- "sample_app/www/periscope_style.yaml" 
 
-    expect_message(create_new_application(name = appTemp.name, location = appTemp.dir, sampleapp = FALSE, rightsidebar = TRUE, style = list(skin = "green")), 
+    expect_message(create_new_application(name = appTemp.name, location = appTemp.dir, sampleapp = FALSE, rightsidebar = NULL, custom_theme_file = yaml_loc), 
                    "Framework creation was successful.")
-    expect_cleanup_create_new_application(appTemp, dashboard_plus = TRUE, skin = "green")
 })
 
-test_that("create_new_application invalid style", {
-    appTemp.dir  <- tempdir()
-    appTemp      <- tempfile(pattern = "TestThatApp", tmpdir = appTemp.dir)
-    appTemp.name <- gsub('\\\\|/', '', (gsub(appTemp.dir, "", appTemp, fixed = T)))
-
-    expect_error(create_new_application(name = appTemp.name, location = appTemp.dir, sampleapp = FALSE, rightsidebar = NULL, style = mtcars), 
-                 "Framework creation could not proceed, invalid type for style, only list allowed")
-})
 
 test_that("create_new_application invalid location", {
     expect_warning(create_new_application(name = "Invalid", location = tempfile(), sampleapp = FALSE),