Merge pull request #67 from dfe-analytical-services/development

Development

.github/workflows/deploy-shiny.yaml

@@ -69,7 +69,7 @@ jobs:
         shell: Rscript {0}
         run: |
           if (!requireNamespace("renv", quietly = TRUE)) install.packages("renv")
-          renv::install("rsconnect@0.8.29")
+          renv::install("rsconnect")
          
 # Tokens are stored as secrets in GitHub to make sure only DfE analysts can publish apps in our shiny.io area
 # Navigate to Settings > Secrets to add and view secrets. These can also be things like admin login and passwords for SQL databases.
@@ -79,5 +79,5 @@ jobs:
         run: >
           Rscript
           -e "rsconnect::setAccountInfo(name = 'department-for-education', token = '${{secrets.SHINYAPPS_TOKEN}}', secret = '${{secrets.SHINYAPPS_SECRET}}')"
-          -e "rsconnect::deployApp(appName=${{env.SHINYAPP_NAME}})"
-          -e "rsconnect::deployApp(appName=${{env.SHINYAPP_OVERFLOW_NAME}})"
+          -e "rsconnect::deployApp(appName=${{env.SHINYAPP_NAME}}, forceUpdate = TRUE)"
+          -e "rsconnect::deployApp(appName=${{env.SHINYAPP_OVERFLOW_NAME}}, forceUpdate = TRUE)"

.hooks/pre-commit.R

@@ -57,9 +57,10 @@ for (file in current_files$files) {
 }
 
 if(grepl('G-Z967JJVQQX', htmltools::includeHTML(("google-analytics.html"))) & 
-   !(toupper(Sys.getenv("USERNAME")) %in% c("CFOSTER4", "CRACE", "LSELBY","RBIELBY", "JEN-MACHIN"))){
+   !(toupper(Sys.getenv("USERNAME")) %in% c("CFOSTER4", "CRACE", "LSELBY","RBIELBY", "JMACHIN"))){
   cat("Cleaning out the template's Google Analytics tag.",fill=TRUE)
   gsub_file("google-analytics.html", pattern = "G-Z967JJVQQX", replacement = "G-XXXXXXXXXX")
+  gsub_file("ui.R", pattern = "Z967JJVQQX", replacement = "XXXXXXXXXX")
   system2(command = "git", args=c("add","google-analytics.html"))
 }
 

R/dashboard_panels.R

@@ -1,3 +1,6 @@
+# message("Sourcing dashboard panels")
+
+
 homepage_panel <- function() {
   tabPanel(
     "User guide and information",

R/dfe_resources.R

@@ -7,4 +7,6 @@
 # 2023-09-21: update made to change hex codes to AF colours package
 # guidance here: https://best-practice-and-impact.github.io/afcolours/
 
+# message("Sourcing gss colour palette")
+
 suppressMessages(gss_colour_pallette <- afcolours::af_colours("categorical", colour_format = "hex", n = 6))

R/dfe_template.R

@@ -2,6 +2,7 @@
 # across dashboards. If you want to change anything in this script, please
 # talk to the DfE Statistics Development team first.
 
+# message("Sourcing dfe_template")
 valueBox <- function(value, subtitle, icon = NULL,
                      color = "blue", width = 4,
                      href = NULL, fontsize = "medium")

R/plotting.R

@@ -1,3 +1,6 @@
+# message("Sourcing plotting")
+
+
 createAvgRevTimeSeries <- function(df, inputArea) {
   ggplot(df, aes(
     x = year,

global.R

@@ -6,6 +6,7 @@
 # whereas the server and UI files are constantly interacting and responsive to user input.
 #
 # ---------------------------------------------------------
+# message("Sourcing global")
 
 
 # Library calls ---------------------------------------------------------------------------------

google-analytics.html

@@ -12,7 +12,7 @@
 </script>
 
 <!-- Global site tag (gtag.js) - Google Analytics -->
-  <script async src="https://www.googletagmanager.com/gtag/js?id=G-XXXXXXXXXX"></script>
+  <script async src="https://www.googletagmanager.com/gtag/js?id=G-Z967JJVQQX"></script>
   <script>
     window.dataLayer = window.dataLayer || [];
     function gtag(){dataLayer.push(arguments);}
@@ -22,7 +22,7 @@
 /*
 The tracking number below MUST be replaced with a unique number, contact the statistics development team to set this up. 
 */
-  gtag('config', 'G-XXXXXXXXXX');
+  gtag('config', 'G-Z967JJVQQX');
 
 
   $(document).on('change', 'select#selectPhase', function(e) {

renv/settings.json

@@ -7,6 +7,8 @@
     "Depends",
     "LinkingTo"
   ],
+  "ppm.enabled": null,
+  "ppm.ignored.urls": [],
   "r.version": [],
   "snapshot.type": "implicit",
   "use.cache": true,

server.R

@@ -74,28 +74,12 @@ server <- function(input, output, session) {
     }
   })
 
-  # output if cookie is unspecified
   observeEvent(input$cookies, {
     if (!is.null(input$cookies)) {
       if (!("dfe_analytics" %in% names(input$cookies))) {
-        shinyalert(
-          inputId = "cookie_consent",
-          title = "Cookie consent",
-          text = "This site uses cookies to record traffic flow using Google Analytics",
-          size = "s",
-          closeOnEsc = TRUE,
-          closeOnClickOutside = FALSE,
-          html = FALSE,
-          type = "",
-          showConfirmButton = TRUE,
-          showCancelButton = TRUE,
-          confirmButtonText = "Accept",
-          confirmButtonCol = "#AEDEF4",
-          timer = 0,
-          imageUrl = "",
-          animation = TRUE
-        )
+        shinyjs::show(id = "cookieMain")
       } else {
+        shinyjs::hide(id = "cookieMain")
         msg <- list(
           name = "dfe_analytics",
           value = input$cookies$dfe_analytics
@@ -110,30 +94,48 @@ server <- function(input, output, session) {
           }
         }
       }
+    } else {
+      shinyjs::hide(id = "cookieMain")
     }
   })
 
-  observeEvent(input$cookie_consent, {
+  # Need these set of observeEvent to create a path through the cookie banner
+  observeEvent(input$cookieAccept, {
     msg <- list(
       name = "dfe_analytics",
-      value = ifelse(input$cookie_consent, "granted", "denied")
+      value = "granted"
     )
     session$sendCustomMessage("cookie-set", msg)
     session$sendCustomMessage("analytics-consent", msg)
-    if ("cookies" %in% names(input)) {
-      if ("dfe_analytics" %in% names(input$cookies)) {
-        if (input$cookies$dfe_analytics == "denied") {
-          ga_msg <- list(name = paste0("_ga_", google_analytics_key))
-          session$sendCustomMessage("cookie-remove", ga_msg)
-        }
-      }
-    }
+    shinyjs::show(id = "cookieAcceptDiv")
+    shinyjs::hide(id = "cookieMain")
+  })
+
+  observeEvent(input$cookieReject, {
+    msg <- list(
+      name = "dfe_analytics",
+      value = "denied"
+    )
+    session$sendCustomMessage("cookie-set", msg)
+    session$sendCustomMessage("analytics-consent", msg)
+    shinyjs::show(id = "cookieRejectDiv")
+    shinyjs::hide(id = "cookieMain")
+  })
+
+  observeEvent(input$hideAccept, {
+    shinyjs::toggle(id = "cookieDiv")
+  })
+
+  observeEvent(input$hideReject, {
+    shinyjs::toggle(id = "cookieDiv")
   })
 
   observeEvent(input$remove, {
+    shinyjs::toggle(id = "cookieMain")
     msg <- list(name = "dfe_analytics", value = "denied")
     session$sendCustomMessage("cookie-remove", msg)
     session$sendCustomMessage("analytics-consent", msg)
+    print(input$cookies)
   })
 
   cookies_data <- reactive({
@@ -156,6 +158,12 @@ server <- function(input, output, session) {
     }
   })
 
+  observeEvent(input$cookieLink, {
+    # Need to link here to where further info is located.  You can
+    # updateTabsetPanel to have a cookie page for instance
+    updateTabsetPanel(session, "navlistPanel", selected = "Support and feedback")
+  })
+
 
   #  output$cookie_status <- renderText(as.character(input$cookies))
 

tests/testthat/_snaps/initial_load/basic_load-001.json

@@ -1,27 +1,16 @@
 {
   "input": {
-    ".clientValue-default-plotlyCrosstalkOpts": {
-      "on": "plotly_click",
-      "persistent": false,
-      "dynamic": false,
-      "selectize": false,
-      "opacityDim": 0.2,
-      "selected": {
-        "opacity": 1
-      },
-      "debounce": 0,
-      "color": [
-
-      ]
-    },
+    "cookieAccept": 0,
+    "cookieLink": 0,
+    "cookieReject": 0,
     "cookies": {
 
     },
+    "hideAccept": 0,
+    "hideReject": 0,
     "link_to_app_content_tab": 0,
     "navlistPanel": "dashboard",
     "plotly_afterplot-A": "\"lineRevBal\"",
-    "plotly_relayout-A": "{\"width\":1073,\"height\":400}",
-    "remove": 0,
     "selectArea": "England",
     "selectBenchLAs": null,
     "selectPhase": "All LA maintained schools",
@@ -418,8 +407,5 @@
         }
       ]
     }
-  },
-  "export": {
-
   }
 }

tests/testthat/test-initial_load.R

@@ -8,7 +8,27 @@ app$wait_for_idle(500)
 # Screenshots are left on for this script to help with troubleshooting
 # They will not cause any failures if there's changes
 
+inputs <- c(
+  "cookieAccept", "cookieLink",
+  "cookieReject", "cookies", "hideAccept", "hideReject",
+  "link_to_app_content_tab",
+  "navlistPanel",
+  "plotly_afterplot-A",
+  "selectArea", "selectBenchLAs", "selectPhase",
+  "tabsetpanels"
+)
+
+outputs <- c(
+  "boxavgRevBal", "boxavgRevBal_large", "boxavgRevBal_small",
+  "boxpcRevBal", "boxpcRevBal_large", "boxpcRevBal_small",
+  "dropdown_label",
+  "lineRevBal"
+)
+
 test_that("App loads", {
   # Capture initial values
-  app$expect_values()
+  app$expect_values(
+    input = inputs,
+    output = outputs
+  )
 })

ui.R

@@ -54,8 +54,6 @@
 #    https://github.com/moj-analytical-services/shinyGovstyle
 #
 
-
-
 ui <- function(input, output, session) {
   fluidPage(
     # use_tota11y(),
@@ -102,6 +100,7 @@ ui <- function(input, output, session) {
         href = "dfe_shiny_gov_style.css"
       )
     ),
+    shinyGovstyle::cookieBanner("DfE R-Shiny dashboard template"),
     shinyGovstyle::header(
       main_text = "",
       main_link = "https://www.gov.uk/government/organisations/department-for-education",

www/dfe_shiny_gov_style.css

@@ -43,6 +43,10 @@ a:active {
   text-decoration: underline
 }
 
+.govuk-cookie-banner {
+  padding: 6px 6px 6px 6px;
+}
+
 /* This line sets the main area width. Originally set to 66.667% in the GDS 
 template. 80% works well here to reduce white space on the right hand side.*/
 .col-sm-8{ width: 80%}