Merge pull request #143 from The-Strategy-Unit/john_fixes

John fixes

R/module_home.R

@@ -120,12 +120,25 @@ home_server <- function(id, params_file_path, upload_event) {
 
     output$user_upload_xlsx_msg <- renderUI({
       if (upload_event$success) {
-        tags$span(upload_event$msg)
+        tags$div(
+          tags$span(
+            "\u2714 ",
+            tags$strong(upload_event$msg),
+            style = "color: green"
+          ),
+          tags$br(),
+          tags$br()
+        )
       } else {
-        tags$span(
-          tags$strong("Error: "),
-          upload_event$msg,
-          style = "color: red"
+        tags$div(
+          tags$span(
+            "\u2718 ",
+            tags$strong("Error: "),
+            upload_event$msg,
+            style = "color: red"
+          ),
+          tags$br(),
+          tags$br()
         )
       }
     })

R/module_results.R

@@ -132,8 +132,20 @@ results_server <- function(id, params, model_output) {
             "model_output must be a reactive" = is.reactive(model_output))
 
   moduleServer(id, function(input, output, session) {
+
     output$download_report <- downloadHandler(
-      filename = "report.pdf",
+      filename = function() {
+        paste0(
+          format(Sys.time(), "%Y-%m-%d_%H%M%S"),
+          "_",
+          if(input$download_choice == "all") {
+            "AllServices"
+          } else {
+            gsub(" ", "", input$services, fixed = TRUE)
+          },
+          ".pdf"
+        )
+      },
       content = function(file) {
         model_output <- model_output()
         params <- reactiveValuesToList(params)
@@ -145,6 +157,7 @@ results_server <- function(id, params, model_output) {
 
         rmarkdown::render(
           app_sys("app/data/report.Rmd"),
+          output_dir = tempdir(),
           output_file = file,
           envir = current_env()
         )

inst/app/data/report.Rmd

@@ -24,9 +24,10 @@ if (!(exists("params") && setequal(names(params), c("groups", "treatments", "cur
 # model_output/services should exist in the environment, but recreate them if not
 
 if (!exists("model_output")) {
+  start_month <- min(params$demand[[1]]$month)
   model_output <- params %>%
-    run_model(24, 0.2) %>%
-    get_model_output()
+    run_model(0.2) %>%
+    get_model_output(start_month)
 }
 
 if (!exists("services")) {

tests/testthat/test-module_home.R

@@ -88,8 +88,20 @@ test_that("it renders upload messages correctly", {
     session$private$flush()
 
     h <- output$user_upload_xlsx_msg$html
-    expect_equal(as.character(h),
-                 "<span>Success</span>")
+    expect_equal(
+      as.character(h),
+      as.character(
+        tags$div(
+          tags$span(
+            style = "color: green",
+            "\u2714 ",
+            tags$strong("Success")
+          ),
+          tags$br(),
+          tags$br()
+        )
+      )
+    )
 
     upload_event$counter <- 2
     upload_event$success <- FALSE
@@ -100,10 +112,15 @@ test_that("it renders upload messages correctly", {
     expect_equal(
       as.character(h),
       as.character(
-        tags$span(
-          style = "color: red",
-          tags$strong("Error: "),
-          "message"
+        tags$div(
+          tags$span(
+            style = "color: red",
+            "\u2718 ",
+            tags$strong("Error: "),
+            "message"
+          ),
+          tags$br(),
+          tags$br()
         )
       )
     )

tests/testthat/test-module_results.R

@@ -37,6 +37,7 @@ test_that("it set's up download handlers correctly", {
   m <- mock(renderUI("download_report"), renderUI("download_output"))
 
   stub(results_server, "downloadHandler", m)
+  stub(results_server, "tempdir", "tempdir/")
 
   testServer(results_server, args = results_server_args(), {
     session$setInputs(download_choice = "all")
@@ -50,7 +51,7 @@ test_that("it set's up download handlers correctly", {
 
     # output$download_report
     expect_length(ma[[1]], 2) # 2 args
-    expect_equal(ma[[1]]$filename, "report.pdf")
+    expect_type(ma[[1]]$filename, "closure")
     expect_type(ma[[1]]$content, "closure")
 
     m1c <- mock("rmarkdown::render", cycle = TRUE)
@@ -62,15 +63,17 @@ test_that("it set's up download handlers correctly", {
     expect_called(m1c, 2)
     expect_args(m1c, 1,
                 app_sys("app/data/report.Rmd"),
+                output_dir = "tempdir/",
                 output_file = "file.pdf",
                 envir = "env")
     expect_args(m1c, 2,
                 app_sys("app/data/report.Rmd"),
+                output_dir = "tempdir/",
                 output_file = "file.pdf",
                 envir = "env")
 
     # output$download_output
-    expect_length(ma[[2]], 3) # 3 args
+    expect_length(ma[[2]], 3)
     expect_type(ma[[2]]$filename, "closure")
     expect_type(ma[[2]]$content, "closure")
     expect_equal(ma[[2]]$contentType, "text/csv")

tests/testthat/test-plot_create_graph.R

@@ -34,26 +34,24 @@ test_that("it calls plotly", {
   expect_args(m3, 1, "layout", displayModeBar = FALSE)
 })
 
-# test is failing: to fix
-# test_that("it filters the data correctly", {
-#   m <- mock()
-#   stub(create_graph, "filter", m)
-#   stub(create_graph, "group_by", tibble())
-#   stub(create_graph, "summarise", tibble())
-#   stub(create_graph, "day", 1)
-#
-#   create_graph(model_output, "a", "b", "c")
-#
-#   expect_called(m, 1)
-#   expect_call(m, 1, filter(
-#     .,
-#     .data$type == "treatment",
-#     .data$group %in% groups,
-#     .data$condition %in% conditions,
-#     .data$treatment %in% treatments,
-#     day(.data$date) == 1
-#   ))
-# })
+test_that("it filters the data correctly", {
+  m <- mock(tibble())
+  stub(create_graph, "filter", m)
+  stub(create_graph, "group_by", function(x, ...) x)
+  stub(create_graph, "summarise", function(x, ...) x)
+  stub(create_graph, "day", 1)
+
+  create_graph(model_output)
+
+  expect_call(m, 1, filter(
+    .,
+    .data$type == "treatment",
+    .data$group %in% groups,
+    .data$condition %in% conditions,
+    .data$treatment %in% treatments,
+    day(.data$date) == 1
+  ))
+})
 
 test_that("it returns NULL if there is no data", {
   stub(create_graph, "filter", tibble())