merge develop in next_release

Merge remote-tracking branch 'origin/develop' into next_release # Conflicts: # DESCRIPTION # NEWS.md
rte-antares-rpackage · Dec 6, 2017 · dc2bdd6 · dc2bdd6
2 parents fa548c0 + ed9eef0
commit dc2bdd6
Show file tree

Hide file tree

Showing 10 changed files with 82 additions and 34 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,7 +2,7 @@ Package: manipulateWidget
 Type: Package
 Title: Add Even More Interactivity to Interactive Charts
 Version: 0.8.0
-Date: 2017-11-15
+Date: 2017-11-27
 Authors@R: c(
     person("Jalal-Edine", "ZAWAM", email = "[email protected]", role = c("aut", "cre")),
     person("Francois", "Guillem", email = "[email protected]", role = c("aut")),

diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,6 @@
 <!-- Copyright © 2016 RTE Réseau de transport d’électricité --->
 
-# manipulateWidget 0.8.0 (2017-11-15)
+# manipulateWidget 0.8.0 (2017-11-27)
 
 ## New features
 * `manipulateWidget()` has a new parameter `.updateBtnInit`. In case of update button `.updateBtn`, you can decide to render graphics on init or not.
@@ -10,6 +10,8 @@
 * A new virtual input called `mwSharedValue` has been introduced. It can be used to avoid repeating the same computations when inputs and output use a common intermediary value. It can also be used when
 `manipulateWidget()` is used in a shiny application to send data from the main application to the module.
 * `manipulateWidget()` now only updates the dependant inputs and outputs when user changes the value of an input. This can lead to important performance improvement in complicated applications.
+* `mwModule()` now return `controller` value, with possibility to use new `clear()` method
+* add `header`, `footer` and `fluidRow` arguments to `mwModuleUI()`
 
 ## Bugfixes
 * When a UI contained dynamic inputs, output was sometimes updated before inputs, which could lead to some errors.

diff --git a/R/controller.R b/R/controller.R
@@ -91,6 +91,10 @@ MWController <- setRefClass(
       invisible(.self)
     },
 
+    clear = function(){
+      rm(list = ls(envir = .self, all.names = TRUE), envir = .self, inherits = TRUE)
+    },
+
     setShinySession = function(output, session) {
       catIfDebug("Set shiny session")
       session <<- session
@@ -155,12 +159,15 @@ MWController <- setRefClass(
 
     updateChart = function(chartId = 1) {
       catIfDebug("Update chart", chartId)
-      e <- new.env(parent = envs$ind[[chartId]]) # User can set values in expr without messing environments
-      charts[[chartId]] <<- eval(expr, envir = e)
-      if (useCombineWidgets) {
-        charts[[chartId]] <<- combineWidgets(charts[[chartId]])
+      if(!is.null(envs)){
+        e <- new.env(parent = envs$ind[[chartId]]) # User can set values in expr without messing environments
+        charts[[chartId]] <<- eval(expr, envir = e)
+        if (useCombineWidgets) {
+          charts[[chartId]] <<- combineWidgets(charts[[chartId]])
+        }
+        renderShinyOutput(chartId)
       }
-      renderShinyOutput(chartId)
+
     },
 
     returnCharts = function() {
@@ -254,6 +261,7 @@ MWController <- setRefClass(
 
     getModuleServer = function() {
       function(input, output, session, ...) {
+
         controller <- .self$clone()
 
         reactiveValueList <- list(...)
@@ -295,6 +303,8 @@ MWController <- setRefClass(
                                     file = con, selfcontained = TRUE)
           }
         )
+
+        return(controller)
       }
     }
   )

diff --git a/R/input_class.R b/R/input_class.R
@@ -147,6 +147,7 @@ Input <- setRefClass(
       }
       if (!emptyField(validFunc)) value <<- validFunc(evalValue(newValue, env), getParams())
       assign(name, value, envir = env)
+      valueHasChanged <<- FALSE
       value
     },
 

diff --git a/R/inputs.R b/R/inputs.R
@@ -455,6 +455,7 @@ mwDateRange <- function(value = c(Sys.Date(), Sys.Date() + 1), label = NULL, ...
       if (length(x) == 0) x <- c(Sys.Date(), Sys.Date())
       else if (length(x) == 1) x <-  c(x, Sys.Date())
       x <- as.Date(x)
+      x[is.na(x)] <- Sys.Date()
       if (!is.null(params$min)) {
         params$min <- as.Date(params$min)
         if(x[1] == Sys.Date()){

diff --git a/R/module_ui.R b/R/module_ui.R
@@ -67,9 +67,16 @@ mwModule <- function(id, controller, ...) {
 #'   units.
 #' @param width Width of the module UI.
 #' @param height Height of the module UI.
+#' @param header	Tag or list of tags to display as a common header above all tabPanels.
+#' @param footer	Tag or list of tags to display as a common footer below all tabPanels
+#' @param fluidRow	Include module in a fluidRow ? Can be usefull in a shiny app. Defaut to FALSE
+#'
 #' @rdname mwModule
 #' @export
-mwModuleUI <- function(id, border = TRUE, okBtn = FALSE, saveBtn = TRUE, margin = 0, width = "100%", height = 400) {
+mwModuleUI <- function(id, border = TRUE, okBtn = FALSE, saveBtn = TRUE, margin = 0,
+                       width = "100%", height = 400, header = NULL, footer = NULL,
+                       fluidRow = FALSE) {
+
   ns <- shiny::NS(id)
   for (i in seq_along(margin)) {
     margin[i] <- shiny::validateCssUnit(margin[i])
@@ -83,16 +90,36 @@ mwModuleUI <- function(id, border = TRUE, okBtn = FALSE, saveBtn = TRUE, margin
   if(!saveBtn) class <- c(class, "without-save")
   class <- paste(class, collapse = " ")
 
-  res <- shiny::tagList(
-    shiny::uiOutput(ns("ui"), container = function(...) {
-      tags$div(style=sprintf("width:%s;height:%s;padding:%s",
-                             shiny::validateCssUnit(width),
-                             shiny::validateCssUnit(height),
-                             margin),
-               class = class,
-               ...)
-    })
-  )
+  if(fluidRow){
+    res <- shiny::fluidRow(
+      shiny::column(12,
+                    header,
+                    shiny::uiOutput(ns("ui"), container = function(...) {
+                      tags$div(style=sprintf("width:%s;height:%s;padding:%s",
+                                             shiny::validateCssUnit(width),
+                                             shiny::validateCssUnit(height),
+                                             margin),
+                               class = class,
+                               ...)
+                    }),
+                    footer
+      )
+    )
+  } else {
+    res <- shiny::tagList(
+      header,
+      shiny::uiOutput(ns("ui"), container = function(...) {
+        tags$div(style=sprintf("width:%s;height:%s;padding:%s",
+                               shiny::validateCssUnit(width),
+                               shiny::validateCssUnit(height),
+                               margin),
+                 class = class,
+                 ...)
+      }),
+      footer
+    )
+  }
+
 
   htmldep <- htmltools::htmlDependency(
     "manipulateWidget",

diff --git a/inst/examples/example-reactive_values.R b/inst/examples/example-reactive_values.R
@@ -8,7 +8,7 @@ ui <- fillPage(
       textInput("title", label = "Title", value = "glop"),
       selectInput("series", "series", choices = c("series1", "series2", "series3"))
     ),
-    mwModuleUI("ui", height = "100%")
+    mwModuleUI("ui", height = "400px")
   )
 )
 
@@ -36,7 +36,7 @@ server <- function(input, output, session) {
   titre <- reactive({
     input$title
   })
-  #
+
   mwModule("ui", c, title = titre, series = reactive(input$series))
 }
 

diff --git a/inst/examples/example-two_mods_one_app.R b/inst/examples/example-two_mods_one_app.R
@@ -39,14 +39,14 @@ c2 <- manipulateWidget(
 
 ui <- navbarPage(
   "Test manipulateWidget",
-   tabPanel(
-     "Module 1",
-     mwModuleUI("mod1", height = "800px")
-   ),
-   tabPanel(
-     "Module 2",
-     mwModuleUI("mod2", height = "800px")
-   )
+  tabPanel(
+    "Module 1",
+    mwModuleUI("mod1", height = "800px")
+  ),
+  tabPanel(
+    "Module 2",
+    mwModuleUI("mod2", height = "800px")
+  )
 )
 
 server <- function(input, output, session) {

diff --git a/man/mwModule.Rd b/man/mwModule.Rd
diff --git a/tests/testthat/test-mwModuleUI.R b/tests/testthat/test-mwModuleUI.R
@@ -9,15 +9,15 @@ describe("mwModuleUI function", {
     # default
     def_mw_ui <- mwModuleUI(id = "def")
     expect_is(def_mw_ui, "shiny.tag.list")
-    expect_equal(def_mw_ui[[1]]$name, "div")
-    expect_equal(def_mw_ui[[1]]$attribs$id, "def-ui")
-    expect_true(grepl("border", def_mw_ui[[1]]$attribs$class))
+    expect_equal(def_mw_ui[[2]]$name, "div")
+    expect_equal(def_mw_ui[[2]]$attribs$id, "def-ui")
+    expect_true(grepl("border", def_mw_ui[[2]]$attribs$class))
 
     # parameters
     def_mw_ui <- mwModuleUI(id = "def", border = FALSE)
-    expect_false(grepl("border", def_mw_ui[[1]]$attribs$class))
+    expect_false(grepl("border", def_mw_ui[[2]]$attribs$class))
 
     def_mw_ui <- mwModuleUI(id = "def", height = "100%")
-    expect_true(grepl("height:100%", def_mw_ui[[1]]$attribs$style))
+    expect_true(grepl("height:100%", def_mw_ui[[2]]$attribs$style))
   })
 })
-Original file line number
+Diff line change
@@ Expand Up / @@ -147,6 +147,7 @@ Input <- setRefClass( @@
           }
           if (!emptyField(validFunc)) value <<- validFunc(evalValue(newValue, env), getParams())
           assign(name, value, envir = env)
+          valueHasChanged <<- FALSE
           value
         },
@@ Expand Down @@