Create template DfE app

.Rbuildignore

@@ -8,3 +8,4 @@
 ^pkgdown$
 ^.lintr$
 ^data-raw$
+^init_test$

.gitignore

@@ -6,3 +6,4 @@ google-analytics.html
 tests/testthat/google-analytics.html
 docs
 inst/doc
+init_test/

DESCRIPTION

@@ -16,6 +16,7 @@ Depends:
     R (>= 2.10)
 Imports: 
     dplyr,
+    dfeR,
     checkmate,
     glue,
     htmltools,

NAMESPACE

@@ -6,14 +6,18 @@ export(cookies_banner_server)
 export(cookies_banner_ui)
 export(cookies_panel_server)
 export(cookies_panel_ui)
+export(create_dashboard)
 export(custom_disconnect_message)
+export(dfe_content_links)
 export(dfe_cookies_script)
 export(dfe_reactable)
 export(external_link)
 export(header)
 export(init_analytics)
+export(init_commit_hooks)
 export(init_cookies)
 export(init_hooks)
+export(init_workflow)
 export(section_tags)
 export(set_bookmark_include)
 export(support_panel)

R/a11y_panel.R

@@ -9,7 +9,6 @@
 #' [GDS model accessibility statement](https://www.gov.uk/guidance/model-accessibility-statement)
 #'
 #' @param dashboard_title Title of the host dashboard
-#' @param dashboard_url URL for the host dashboard
 #' @param issues_contact URL for the GitHub Issues log or contact e-mail address
 #' for users to flag accessibility issues
 #' @param publication_name The parent publication name (optional)
@@ -23,6 +22,7 @@
 #' @param date_reviewed Date the statement was last reviewed
 #' @param date_template_reviewed Date the underlying template was reviewed
 #' (default: 12th March 2024)
+#' @inheritParams create_dashboard
 #'
 #' @return shiny$tags$div element containing the HTML tags and content for the standard
 #' accessibility statement
@@ -40,25 +40,26 @@
 #'   publication_name = "LA and school expenditure"
 #' )
 a11y_panel <- function(
-    dashboard_title,
-    dashboard_url,
-    date_tested,
-    date_prepared,
-    date_reviewed,
-    date_template_reviewed = "12 March 2024",
-    issues_contact = NULL,
-    publication_name = NULL,
-    publication_slug = NULL,
-    non_accessible_components = c(
-      "Keyboard navigation through the interactive charts is currently limited",
-      "Alternative text in interactive charts is limited to titles"
-    ),
-    specific_issues = c(
-      "Charts have non-accessible components that are inaccessible for keyboard users.",
-      "Chart tooltips are not compatible with screen reader use.",
-      "Some decorative images are not labelled appropriately as yet.",
-      "Some links are not appropriately labelled."
-    )) {
+  dashboard_title,
+  dashboard_url,
+  date_tested,
+  date_prepared,
+  date_reviewed,
+  date_template_reviewed = "12 March 2024",
+  issues_contact = NULL,
+  publication_name = NULL,
+  publication_slug = NULL,
+  non_accessible_components = c(
+    "Keyboard navigation through the interactive charts is currently limited",
+    "Alternative text in interactive charts is limited to titles"
+  ),
+  specific_issues = c(
+    "Charts have non-accessible components that are inaccessible for keyboard users.",
+    "Chart tooltips are not compatible with screen reader use.",
+    "Some decorative images are not labelled appropriately as yet.",
+    "Some links are not appropriately labelled."
+  )
+) {
   # Validate inputs
   date_tested <- validate_date(date_tested)
   date_prepared <- validate_date(date_prepared)
@@ -67,22 +68,31 @@ a11y_panel <- function(
   validate_dashboard_url(dashboard_url)
   if (
     lubridate::interval(
-      lubridate::dmy(date_prepared), lubridate::dmy(date_reviewed)
-    ) / lubridate::days(1) < 0
+      lubridate::dmy(date_prepared),
+      lubridate::dmy(date_reviewed)
+    ) /
+      lubridate::days(1) <
+      0
   ) {
     stop("date_reviewed should be later than date_prepared")
   }
   if (
     lubridate::interval(
-      lubridate::dmy(date_tested), lubridate::dmy(date_reviewed)
-    ) / lubridate::days(1) < 0
+      lubridate::dmy(date_tested),
+      lubridate::dmy(date_reviewed)
+    ) /
+      lubridate::days(1) <
+      0
   ) {
     stop("date_reviewed should be later than date_tested")
   }
   if (
     lubridate::interval(
-      lubridate::dmy(date_template_reviewed), lubridate::dmy(date_reviewed)
-    ) / lubridate::days(1) < 0
+      lubridate::dmy(date_template_reviewed),
+      lubridate::dmy(date_reviewed)
+    ) /
+      lubridate::days(1) <
+      0
   ) {
     warning(
       "The template has been through a review more recently than your dashboard, please get in ",
@@ -101,10 +111,14 @@ a11y_panel <- function(
     }
   }
   if (is.null(publication_name) && !is.null(publication_slug)) {
-    stop("Error: If publication_name is provided, then so should publication_slug.")
+    stop(
+      "Error: If publication_name is provided, then so should publication_slug."
+    )
   }
   if (!is.null(publication_name) && is.null(publication_slug)) {
-    stop("Error: If publication_slug is provided, then so should publication_name.")
+    stop(
+      "Error: If publication_slug is provided, then so should publication_name."
+    )
   }
   shiny::tags$div(
     style = "margin-top: 50px; margin-bottom: 50px",
@@ -140,17 +154,23 @@ a11y_panel <- function(
                     (including the most recent versions of JAWS, NVDA and VoiceOver)"
       )
     )),
-    shiny::tags$p("We've also made the website text as simple as possible to understand."),
+    shiny::tags$p(
+      "We've also made the website text as simple as possible to understand."
+    ),
     shiny::tags$p(
       external_link(href = "https://mcmw.abilitynet.org.uk/", "AbilityNet"),
       " has advice on making your device easier to use if you have a disability."
     ),
     shiny::tags$h2("How accessible this website is"),
     if (all(is.null(non_accessible_components))) {
-      shiny::tags$p("This website is fully compliant with accessibility standards.")
+      shiny::tags$p(
+        "This website is fully compliant with accessibility standards."
+      )
     } else {
       shiny::tagList(
-        shiny::tags$p("We know some parts of this website are not fully accessible:"),
+        shiny::tags$p(
+          "We know some parts of this website are not fully accessible:"
+        ),
         shiny::tags$div(tags$ol(
           tagList(lapply(non_accessible_components, shiny::tags$li))
         ))
@@ -177,9 +197,11 @@ a11y_panel <- function(
         )
       )
     },
-    shiny::tags$p("We're always looking to improve the accessibility of this website.
+    shiny::tags$p(
+      "We're always looking to improve the accessibility of this website.
              If you find any problems not listed on this page or think we're not meeting
-             accessibility requirements, contact us:"),
+             accessibility requirements, contact us:"
+    ),
     shiny::tags$ul(tags$li(
       shiny::tags$a(
         href = "mailto:explore.statistics@education.gov.uk",
@@ -227,8 +249,10 @@ a11y_panel <- function(
           " due to the non-compliances listed below."
         ),
         shiny::tags$h3("Non accessible content"),
-        shiny::tags$p("The content listed below is non-accessible for the following reasons.
-             We will address these issues to ensure our content is accessible."),
+        shiny::tags$p(
+          "The content listed below is non-accessible for the following reasons.
+             We will address these issues to ensure our content is accessible."
+        ),
         shiny::tags$div(tags$ol(
           tagList(lapply(specific_issues, shiny::tags$li))
         ))
@@ -261,7 +285,9 @@ a11y_panel <- function(
       shiny::tags$li("charts, maps, and tables")
     )),
     shiny::tags$p(
-      "This specific website was was last tested on ", date_tested, " against ",
+      "This specific website was was last tested on ",
+      date_tested,
+      " against ",
       external_link(
         href = "https://www.w3.org/TR/WCAG22/",
         "Accessibility Guidelines WCAG2.2"

R/analytics.R

@@ -8,6 +8,7 @@
 #' @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
+#' @inheritParams create_dashboard
 #'
 #' @importFrom magrittr %>%
 #' @return NULL
@@ -17,7 +18,11 @@
 #' if (interactive()) {
 #'   init_analytics(ga_code = "0123456789")
 #' }
-init_analytics <- function(ga_code, create_file = TRUE) {
+init_analytics <- function(
+  ga_code,
+  path = "./",
+  create_file = TRUE
+) {
   if (!is.logical(create_file)) {
     stop("create_file must always be TRUE or FALSE")
   }
@@ -117,8 +122,10 @@ dashboard.
   } 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.")
+      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) "
       ) |>
@@ -132,10 +139,16 @@ dashboard.
       write_out <- TRUE
     }
     if (write_out) {
-      cat(html_script_with_id, file = "google-analytics.html", sep = "\n")
+      cat(
+        html_script_with_id,
+        file = file.path(path, "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(
+        "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 {

R/cookies.R

@@ -85,17 +85,25 @@ dfe_cookies_script <- function() {
 #'
 #' @param id Shiny tag shared with cookies_banner_server(), can be any string set
 #' by the user as long as it matches the id in the cookies_banner_server()
+#' @inheritParams create_dashboard
 #' @param name Name of the dashboard on which the cookie authorisation is being
-#' applied
+#' applied (deprecated, replaced by site_title)
 #'
 #' @family cookies
 #' @return shiny::tags$div()
 #' @export
 #' @inherit cookies examples
 cookies_banner_ui <- function(
-  id = "cookies_banner",
-  name = "DfE R-Shiny dashboard template"
-) {
+    id = "cookies_banner",
+    site_title = "DfE R-Shiny dashboard template",
+    name = NULL
+    ) {
+  if(!is.null(name) & site_title == "DfE R-Shiny dashboard template"){
+    warning(
+      "The use of name as a parameter in cookies_banner_ui is deprecated. Please use site_title."
+      )
+    site_title <- name
+  }
   # Attach CSS from inst/www/css/cookie-banner.css
   dependency <- htmltools::htmlDependency(
     name = "cookie-banner",
@@ -117,10 +125,10 @@ cookies_banner_ui <- function(
           class = "govuk-grid-column-two-thirds",
           shiny::tags$div(
             class = "govuk-cookie-banner__content",
-            shiny::tags$h2(
-              class = "govuk-cookie-banner__heading govuk-heading-m",
-              name
-            ),
+          shiny::tags$h2(
+            class = "govuk-cookie-banner__heading govuk-heading-m",
+            site_title
+          ),
             shiny::tags$p(
               class = "govuk-body",
               "We use some essential cookies to make this service work."
@@ -171,12 +179,11 @@ cookies_banner_ui <- function(
 #' be `reactive(input$cookies)`)
 #' @param parent_session This should be the R Shiny app session, expect it to
 #' always be `parent_session = session`
-#' @param google_analytics_key Provide the GA 10 digit key of the form
-#' "ABCDE12345"
 #' @param cookies_link_panel name of the navigation panel that the cookie banner
 #' provides a link to, usually "cookies_panel_ui"
 #' @param cookies_nav_id ID of the navigation panel the cookie panel page is
 #' within, defaults to "navlistPanel"
+#' @inheritParams create_dashboard
 #'
 #' @family cookies
 #' @return NULL
@@ -356,18 +363,17 @@ Shiny.addCustomMessageHandler('analytics-consent', function(msg){
 #'
 #' @param id Shiny tag shared with cookies_panel_server(), can be any string set by
 #' the user as long as it matches the id in the cookies_panel_server()
-#' @param google_analytics_key Provide the GA 10 digit key of the form
-#' "ABCDE12345"
+#' @inheritParams create_dashboard
 #'
 #' @family cookies
 #' @return a HTML div, containing standard cookies content for a public R
 #' Shiny dashboard in DfE
 #' @export
 #' @inherit cookies examples
 cookies_panel_ui <- function(
-  id = "cookies_panel",
-  google_analytics_key = NULL
-) {
+    id = "cookies_panel",
+    google_analytics_key = NULL
+    ) {
   shiny::tags$div(
     style = "margin-top: 50px; margin-bottom: 50px;",
     shiny::tags$h1("Cookies"),
@@ -474,8 +480,7 @@ cookies_panel_ui <- function(
 #' the user as long as it matches the id in the cookies_panel_ui()
 #' @param input_cookies The cookie input passed from cookies.js (should always
 #' be `reactive(input$cookies)`)
-#' @param google_analytics_key Provide the GA 10 digit key of the form
-#' "ABCDE12345"
+#' @inheritParams create_dashboard
 #'
 #' @family cookies
 #' @export