Eesp/connect eesyapi

.Rprofile

@@ -10,17 +10,12 @@
 
 cat("Sourcing .Rprofile.", fill = TRUE)
 
+print(Sys.info())
 source("renv/activate.R")
-renv::status()
 
-# Run UI tests ------------------------------------------------------------
-
-run_tests_locally <- function() {
-  library(shinytest2)
-  Sys.unsetenv("HTTP_PROXY")
-  test_app()
+# Install commit-hooks locally
+if (file.exists(".git")) {
+  statusWriteCommit <- file.copy(".hooks/pre-commit.R", ".git/hooks/pre-commit", overwrite = TRUE)
 }
 
-
-# Install commit-hooks locally
-statusWriteCommit <- file.copy(".hooks/pre-commit.R", ".git/hooks/pre-commit", overwrite = TRUE)
+message("End of .Rprofile")

.github/workflows/automatedTests.yaml

@@ -0,0 +1,9 @@
+on:
+  push:
+    branches:
+      - main
+  pull_request:
+
+jobs:
+  automated-tests:
+    uses: dfe-analytical-services/dfeshiny/.github/workflows/automated_tests_template.yaml@main

.github/workflows/create-trello-ticket.yaml

@@ -0,0 +1,12 @@
+name: Trello PR card
+on:
+  pull_request_target:
+    types:
+      - opened
+
+jobs:
+  create-card:
+    uses: dfe-analytical-services/dfeshiny/.github/workflows/create_trello_card_template.yaml@new-feature/trello-pr-workflow
+    secrets:
+      TRELLO_API_KEY: '${{ secrets.TRELLO_API_KEY }}'
+      TRELLO_API_TOKEN: '${{ secrets.TRELLO_API_TOKEN }}'

.github/workflows/deploy-shiny.yaml

@@ -4,6 +4,7 @@ on:
     branches:
       - main
       - development
+      - eesp/connect-eesyapi
   pull_request:
     branches:
       - main

.github/workflows/lintr.yml

@@ -9,17 +9,9 @@ on:
 
 name: lintr
 
-permissions:
-  contents: read
-
 jobs:
   lintr:
     runs-on: ubuntu-latest
-
-    permissions:
-      contents: read # for checkout to fetch code
-      security-events: write # for github/codeql-action/upload-sarif to upload SARIF results
-
     container:
       image: ghcr.io/dfe-analytical-services/dfe-r-base:latest
       options: --user root
@@ -33,7 +25,7 @@ jobs:
       - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
-
+      
       - name: Restore renv snapshot
         shell: Rscript {0}
         run: |

.hooks/pre-commit.R

@@ -2,9 +2,8 @@
 cat("Running commit hooks...", fill = TRUE)
 shhh <- suppressPackageStartupMessages # It's a library, so shhh!
 shhh(library(dplyr))
-shhh(library(dfeshiny))
 shhh(library(xfun))
-
+shhh(library(dfeshiny))
 
 error_flag <- FALSE
 
@@ -29,8 +28,6 @@ if (ncol(ign_files) > 1) {
   }
 }
 
-
-
 suffixes <- "xlsx$|dat$|csv$|tex$|pdf$"
 
 current_files <- data.frame(files = list.files("./", recursive = TRUE)) %>%
@@ -69,7 +66,7 @@ if (error_flag) {
   quit(save = "no", status = 1, runLast = FALSE)
 }
 
-tidy_output <- tidy_code()
+tidy_output <- dfeshiny::tidy_code()
 if (any(tidy_output)) {
   error_flag <- TRUE
 }
@@ -80,4 +77,20 @@ if (error_flag) {
   quit(save = "no", status = 1, runLast = FALSE)
 }
 
+cat("\n")
+
+cat("\n2. Rebuilding manifest.json...", fill = TRUE)
+if (system.file(package = "git2r") == "") {
+  renv::install("git2r")
+}
+shhh(library(git2r))
+if (system.file(package = "rsconnect") != "" & system.file(package = "git2r") != "") {
+  if (!any(grepl("manifest.json", git2r::status()))) {
+    rsconnect::writeManifest()
+    git2r::add(path = "manifest.json")
+  }
+  cat("...manifest.json rebuilt\n")
+}
+cat("\n")
+
 # End of hooks

R/fetch_data.R

@@ -0,0 +1,76 @@
+# fetch sqid lookup creates a lookup list of IDs for each filter and indicator entry
+fetch_sqid_lookup <- function(
+    dataset_id,
+    version = NULL,
+    ees_environment = "test",
+    verbose = FALSE) {
+  meta <- eesyapi::get_meta(
+    dataset_id,
+    ees_environment = ees_environment,
+    verbose = verbose
+  )
+  sqid_lookup <- list(
+    filters = filter_item_sqid_list(meta$filter_items),
+    indicators = indicator_sqid_list(meta$indicators)
+  )
+  return(sqid_lookup)
+}
+
+indicator_sqid_list <- function(indicator_meta) {
+  indicator_list <- as.list(
+    indicator_meta |>
+      pull(col_id)
+  )
+  names(indicator_list) <- indicator_meta |>
+    pull(col_name)
+  return(indicator_list)
+}
+
+
+filter_item_sqid_sublist <- function(col_name_ref, filter_lookup) {
+  filter_list <- as.list(
+    filter_lookup |> filter(col_name == col_name_ref) |> pull(item_id)
+  )
+  names(filter_list) <- filter_lookup |>
+    filter(col_name == col_name_ref) |>
+    pull(item_label) |>
+    str_replace_all(" ", "") |>
+    str_replace_all("\\(", "_") |>
+    str_replace_all("\\)", "") |>
+    tolower()
+  return(filter_list)
+}
+
+filter_item_sqid_list <- function(filter_lookup) {
+  col_names <- filter_lookup |>
+    pull(col_name) |>
+    unique()
+  filter_list <- lapply(col_names, filter_item_sqid_sublist, filter_lookup)
+  names(filter_list) <- col_names
+  return(filter_list)
+}
+
+geography_query <- function(
+    input_geographic_level,
+    input_region_name,
+    input_la_name) {
+  message(input_geographic_level, input_region_name, input_la_name)
+  query <- "National"
+  if (input_geographic_level == "Regional") {
+    reg_code <- dfeR::fetch_regions() |>
+      dplyr::filter(region_name == input_region_name) |>
+      dplyr::pull(region_code)
+    query <- c(query, paste0("REG|code|", reg_code))
+  } else if (input_geographic_level == "Local authority") {
+    reg_code <- region_la_lookup |>
+      dplyr::filter(la_name == input_la_name) |>
+      dplyr::pull(region_code)
+    query <- c(query, paste0("REG|code|", reg_code))
+    la_code <- dfeR::fetch_las() |>
+      dplyr::filter(la_name == input_la_name) |>
+      dplyr::pull(new_la_code)
+    query <- c(query, paste0("LA|code|", la_code))
+  }
+
+  return(query)
+}

R/gov_colours.R

@@ -1,43 +1,5 @@
 # Script to take government approved colour schemes for the app, from: https://github.com/ukgovdatascience/govstyle/blob/master/R/GVA.R
 
-# Create a palette
-
-gov_cols <- c(
-  purple      = "#2E358B",
-  pink        = "#D53880",
-  mellow_red  = "#DF3034",
-  yellow      = "#FFBF47",
-  turquoise   = "#28A197",
-  mauve       = "#6F72AF",
-  baby_pink   = "#F499BE",
-  orange      = "#F47738",
-  green       = "#006435",
-  light_blue  = "#2B8CC4",
-  fuschia     = "#912B88",
-  red         = "#B10E1E",
-  brown       = "#B58840",
-  grass_green = "#85994B",
-  govuk_blue  = "#005EA5"
-)
-
-gov_cols_2 <- c(
-  "#2E358B",
-  "#D53880",
-  "#DF3034",
-  "#FFBF47",
-  "#28A197",
-  "#6F72AF",
-  "#F499BE",
-  "#F47738",
-  "#006435",
-  "#2B8CC4",
-  "#912B88",
-  "#B10E1E",
-  "#B58840",
-  "#85994B",
-  "#005EA5"
-)
-
 # https://meyerweb.com/eric/tools/color-blend/#FFBF47:B10E1E:3:hex gov red to yellow
 
 map_gov_colours <- c(
@@ -66,84 +28,3 @@ check_pal <- function(
     labels = names(x)
   )
 }
-
-# Create a theme
-
-theme_gov <- function(
-    base_size = 12,
-    base_colour = "gray40",
-    axes = "x") {
-  if (!axes %in% c("n", "x", "y", "xy")) {
-    stop("axes must be one of 'n', 'x', 'y', or 'xy'")
-  }
-
-  ## Set x and y axis colour
-
-  x_col <- "white"
-  y_col <- "white"
-
-  if (axes == "x") {
-    x_col <- base_colour
-    y_col <- "white"
-  }
-
-  if (axes == "y") {
-    x_col <- "white"
-    y_col <- base_colour
-  }
-
-  if (axes == "xy") {
-    x_col <- base_colour
-    y_col <- base_colour
-  }
-
-  theme(
-    legend.position = "none",
-
-    ## Adjust tick marks
-
-    axis.ticks = ggplot2::element_blank(),
-    # axis.ticks = element_line(colour = "gray40"),
-    # axis.ticks.y = element_blank(),
-    # axis.ticks.length = grid::unit( -2, "mm"),
-
-    ## Adjust the axis lines
-
-    axis.line = ggplot2::element_line(colour = base_colour),
-    axis.line.x = ggplot2::element_line(colour = x_col),
-    axis.line.y = ggplot2::element_line(colour = y_col),
-
-    ## Set the overall text attributes
-
-    text = ggplot2::element_text(
-      face = "plain", colour = base_colour, size = base_size,
-      hjust = 0.5, vjust = 0.5, angle = 0, lineheight = 0.8
-    ),
-    axis.text = ggplot2::element_text(colour = base_colour),
-    plot.title = ggplot2::element_text(face = "bold", hjust = 1, colour = "black", vjust = -2.5),
-
-    ## Axis title attributes. Adjustments of
-
-    axis.title.y = ggplot2::element_text(hjust = 1, vjust = 1),
-    axis.title.x = ggplot2::element_text(hjust = 1, vjust = 0),
-
-    ## Background attributes (currently all blank)
-
-    panel.background = ggplot2::element_blank(),
-    panel.grid.major = ggplot2::element_blank(),
-    panel.grid.minor = ggplot2::element_blank(),
-
-    ## Adjust the margin around the plot. This is highly sensitive to plot, so
-    ## probably needs to be set on a plot by plot basis.
-
-    # plot.margin = grid::unit(c(0,5,5,-30), "mm"),
-
-    ## Strip attributes for facet grid and facet wrap
-
-    strip.background = ggplot2::element_blank(),
-    strip.text = ggplot2::element_text(color = "black", face = "bold", size = base_size + 1),
-    strip.text.x = ggplot2::element_text(),
-    strip.text.y = ggplot2::element_text(angle = -90),
-    complete = FALSE
-  )
-}