Part 2 - Make init code inline (#44)

* Update init_analytics to have a create_file option and add more unit tests around the content

* Move the init_analytics HTML / JS to be written inline

* Prevent init_analytics from running in examples and creating scripts in the check directory

* update init_cookies to have the JS code inline and add some tests

R/analytics.R

@@ -1,16 +1,27 @@
 #' init_analytics
+#'
 #' @description
 #' Creates the google-analytics.html script in order to allow the activation of
 #' analytics via GA4. For the full steps required to set up analytics, please
-#' refer to the documentation in the readme.
+#' refer to the documentation in the README.
+#'
+#' @param ga_code The Google Analytics code for the dashboard
+#' @param create_file Boolean TRUE or FALSE, default is TRUE, false will return
+#' the HTML in the console and is used mainly for testing or comparisons
 #'
-#' @param ga_code The Google Analytics code
 #' @importFrom magrittr %>%
-#' @return TRUE if written, FALSE if not
+#' @return NULL
 #' @export
 #'
-#' @examples init_analytics(ga_code = "0123456789")
-init_analytics <- function(ga_code) {
+#' @examples
+#' if (interactive()) {
+#'   init_analytics(ga_code = "0123456789")
+#' }
+init_analytics <- function(ga_code, create_file = TRUE) {
+  if (!is.logical(create_file)) {
+    stop("create_file must always be TRUE or FALSE")
+  }
+
   is_valid_ga4_code <- function(ga_code) {
     stringr::str_length(ga_code) == 10 & typeof(ga_code) == "character"
   }
@@ -23,50 +34,112 @@ init_analytics <- function(ga_code) {
     )
   }
 
-  github_area <- "https://raw.githubusercontent.com/dfe-analytical-services/"
-  webpage <- RCurl::getURL(
-    paste0(
-      github_area,
-      "dfeshiny/main/inst/google-analytics.html"
-    )
-  )
-  tryCatch(
-    html_script <- gsub(
-      "XXXXXXXXXX",
-      ga_code,
-      readLines(tc <- textConnection(webpage))
-    ),
-    error = function(e) {
-      return("Download failed")
-    },
-    message("Downloaded analytics template script")
-  )
-
-  close(tc)
-  if (file.exists("google-analytics.html")) {
-    message("Analytics file already exists.")
-    message("If you have any customisations in that file, make sure you've
+  # Google analytics HTML =====================================================
+  html_script <- "<script>
+// Define dataLayer and the gtag function.
+window.dataLayer = window.dataLayer || [];
+function gtag(){dataLayer.push(arguments);}
+
+// Default ad_storage to 'denied' as a placeholder
+// Determine actual values based on your own requirements
+gtag('consent', 'default', {
+  'ad_storage': 'denied',
+  'analytics_storage': 'denied'
+});
+</script>
+
+<!-- Global site tag (gtag.js) - Google Analytics -->
+  <script async src='https://www.googletagmanager.com/gtag/js?id=G-XXXXXXXXXX'></script>
+  <script>
+    window.dataLayer = window.dataLayer || [];
+    function gtag(){dataLayer.push(arguments);}
+
+    gtag('js', new Date());
+
+  gtag('config', 'G-XXXXXXXXXX');
+
+/*
+The custom trackers below can be tailored to match the inputs used in your
+dashboard.
+*/
+
+  $(document).on('change', 'select#selectPhase', function(e) {
+    gtag('event', 'select phase', {'event_category' : 'choose Phase',
+    'event_label' : document.querySelector('select#selectPhase').value
+    });
+  });
+
+  $(document).on('change', 'select#selectArea', function(e) {
+    gtag('event', 'select area', {'event_category' : 'choose Area',
+    'event_label' : document.querySelector('select#selectArea').value
+    });
+  });
+
+  $(document).on('click', 'ul#navlistPanel', function(e) {
+    gtag('event', 'navlistPanel', {'event_category' : 'navbar click',
+    'event_label' : document.querySelector(
+    'ul#navlistPanel > li.active > a'
+    ).getAttribute('data-value')
+    });
+  });
+
+  $(document).on('click', 'ul#tabsetpanels', function(e) {
+    gtag('event', 'tab panels', {'event_category' : 'tab panel clicks',
+    'event_label' : document.querySelector(
+    'ul#tabsetpanels > li.active > a'
+    ).getAttribute('data-value')
+    });
+  });
+
+
+  $(document).on('click', 'a#download_data', function(e) {
+    gtag('event', 'Download button', {'event_category' : 'Download button click'
+    });
+  });
+
+  $(document).on('shiny:disconnected', function(e) {
+    gtag('event', 'disconnect', {
+      'event_label' : 'Disconnect',
+      'event_category' : 'Disconnect'
+    });
+  });
+
+</script>"
+
+  # Swap in the GA ID
+  html_script_with_id <- gsub("XXXXXXXXXX", ga_code, html_script)
+
+  # End of google analytics HTML ==============================================
+
+  if (create_file == FALSE) {
+    # Just return without options or messages
+    cat(html_script_with_id, file = "", sep = "\n")
+  } else {
+    if (file.exists("google-analytics.html")) {
+      message("Analytics file already exists.")
+      message("If you have any customisations in that file, make sure you've
     backed those up before over-writing.")
-    user_input <- readline(
-      prompt = "Are you happy to overwrite the existing analytics script (y/N) "
-    ) |>
-      stringr::str_trim()
-    if (user_input %in% c("y", "Y")) {
+      user_input <- readline(
+        prompt = "Are you happy to overwrite the existing analytics script (y/N) "
+      ) |>
+        stringr::str_trim()
+      if (user_input %in% c("y", "Y")) {
+        write_out <- TRUE
+      } else {
+        write_out <- FALSE
+      }
+    } else {
       write_out <- TRUE
+    }
+    if (write_out) {
+      cat(html_script_with_id, file = "google-analytics.html", sep = "\n")
+      message("")
+      message("Google analytics script created as google-analytics.html.")
+      message("You'll need to add the following line to your ui.R script to start using analytics:")
+      message("")
+      message("tags$head(includeHTML((google-analytics.html))),")
     } else {
-      write_out <- FALSE
+      message("Original Google analytics html script left in place.")
     }
-  } else {
-    write_out <- TRUE
-  }
-  if (write_out) {
-    cat(html_script, file = "google-analytics.html", sep = "\n")
-    message("")
-    message("Google analytics script created in google-analytics.html.")
-    message("You'll need to add the following line to your ui.R script to start
-            recording analytics:")
-    message('tags$head(includeHTML(("google-analytics.html"))),')
-  } else {
-    message("Original Google analytics html script left in place.")
   }
 }

R/cookies.R

@@ -244,15 +244,18 @@ cookies_banner_server <- function(
 #' init_cookies
 #'
 #' @description
-#' init_cookies() creates a local copy of the JavaScript file
-#' required for cookies to work.
-#' It checks whether there is already a www/ folder and if not, it creates one.
-#' It then checks whether the cookie-consent.js file exists in the www/ folder.
-#' If the file exists, it will print a message in the console to let you know.
-#' If the file doesn't exist, it will pull a copy from the GitHub repo.
-#' If it cannot connect to the repo then it will print "Download failed".
-#' No input parameters are required
-#' Call init_cookies() in the console to run the function
+#' init_cookies() creates a local copy of the JavaScript file required for
+#' cookies to work. It checks whether there is already a www/ folder and if
+#' not, it creates one. It then checks whether the cookie-consent.js file
+#' exists in the www/ folder. If the file exists, it will print a message in
+#' the console to let you know it has overwritten it. If the file doesn't
+#' exist, it will make one and confirm it has done so.
+#'
+#' No input parameters are required, run `init_cookies()` in the console to run
+#' the function
+#'
+#' @param create_file Boolean, TRUE by default, if FALSE then will print to
+#' the console rather than create a new file
 #'
 #' @return NULL
 #' @export
@@ -261,29 +264,58 @@ cookies_banner_server <- function(
 #' if (interactive()) {
 #'   init_cookies()
 #' }
-init_cookies <- function() {
-  sub_dir <- "www"
+init_cookies <- function(create_file = TRUE) {
+  if (!is.logical(create_file)) {
+    stop("create_file must always be TRUE or FALSE")
+  }
 
-  output_dir <- file.path(sub_dir)
+  # Create the JS for the file ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  cookie_js <- "function getCookies(){
+  var res = Cookies.get();
+  Shiny.setInputValue('cookies', res);
+}
 
-  if (!dir.exists(output_dir)) {
-    dir.create(output_dir)
-  } else {
-    message("www folder already exists!")
-  }
+Shiny.addCustomMessageHandler('cookie-set', function(msg){
+  Cookies.set(msg.name, msg.value);
+  getCookies();
+})
 
-  github_area <- "https://raw.githubusercontent.com/dfe-analytical-services/"
+Shiny.addCustomMessageHandler('cookie-clear', function(msg){
+  Cookies.remove(msg.name);
+  getCookies();
+})
 
-  tryCatch(
-    utils::download.file(
-      url = paste0(github_area, "dfeshiny/main/inst/cookie-consent.js"),
-      destfile = "www/cookie-consent.js"
-    ),
-    error = function(e) {
-      return("Download failed")
-    },
-    message("Cookie script updated")
-  )
+$(document).on('shiny:connected', function(ev){
+  getCookies();
+})
+
+Shiny.addCustomMessageHandler('analytics-consent', function(msg){
+  gtag('consent', 'update', {
+    'analytics_storage': msg.value
+  });
+})"
+  # End of JS for the file ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+  if (create_file == TRUE) {
+    sub_dir <- "www"
+
+    output_dir <- file.path(sub_dir)
+
+    if (!dir.exists(output_dir)) {
+      dir.create(output_dir)
+    }
+
+    if (file.exists("www/cookie-consent.js")) {
+      message("www/cookie-consent.js already exists, updating file...")
+      cat(cookie_js, file = "www/cookie-consent.js", sep = "\n")
+      message("...file successfully updated")
+    } else {
+      cat(cookie_js, file = "www/cookie-consent.js", sep = "\n")
+      message("Created cookies script as www/cookie-consent.js")
+    }
+  } else {
+    cat(cookie_js, file = "", sep = "\n")
+  }
 }
 
 #' cookies_panel_ui