Dev/metadata

DESCRIPTION

@@ -26,8 +26,8 @@ Imports:
     tibble
 Suggests: 
     testthat (>= 3.0.0)
+Config/roxygen2/markdown: TRUE
+Config/roxygen2/version: 8.0.0
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.3

NAMESPACE

@@ -4,5 +4,6 @@ export(get_hscp_locality)
 export(get_simd_datazone)
 export(get_simd_postcode)
 export(get_spd)
+export(metadata)
 importFrom(rlang,.data)
 importFrom(tibble,tibble)

R/get_spd.R

@@ -27,10 +27,13 @@
 #' get_spd(version = "2023_2", col_select = c("pc7", "latitude", "longitude"))
 get_spd <- function(version = "latest", col_select = NULL) {
   spd_dir <- fs::path(
-    get_lookups_dir(), "Geography",
+    get_lookups_dir(),
+    "Geography",
     "Scottish Postcode Directory"
   )
 
+  metadata_dir <- fs::path(spd_dir, "Metadata")
+
   if (version == "latest") {
     spd_path <- find_latest_file(
       directory = spd_dir,
@@ -53,8 +56,25 @@ get_spd <- function(version = "latest", col_select = NULL) {
     )
   }
 
-  return(read_file(
+  spd <- read_file(
     spd_path,
     col_select = {{ col_select }}
-  ))
+  )
+
+  metadata_path <- fs::path(metadata_dir, "spd_metadata.csv")
+  metadata_exists <- fs::file_exists(metadata_path)
+
+  spd <- set_metadata_ref(
+    spd,
+    type = "SPD",
+    path = metadata_path,
+    version = version,
+    exists = metadata_exists
+  )
+
+  if (metadata_exists) {
+    inform_metadata_access(spd)
+  }
+
+  return(spd)
 }

R/metadata.R

@@ -0,0 +1,89 @@
+#' Function to access metadata
+#'
+#' @param data Dataset imported using one of the [phslookups] functions,
+#' e.g. `get_spd()`.
+#'
+#' @returns
+#' Metadata `tibble` associated with dataset.
+#'
+#' @examples
+#' library(phslookups)
+#' \dontrun{
+#' spd <- get_spd()
+#' metadata(spd)
+#' }
+#' @export
+metadata <- function(data) {
+  if (!inherits(data, "tbl_df")) {
+    cli::cli_abort(
+      "{.arg data} must must be a tibble loaded using {.pkg phslookups}."
+    )
+  }
+
+  # If already loaded, return immediately
+  metadata <- attr(data, "metadata", exact = TRUE)
+  if (!is.null(metadata)) {
+    return(metadata)
+  }
+
+  ref <- attr(data, "metadata_ref", exact = TRUE)
+
+  if (is.null(ref)) {
+    cli::cli_abort("Metadata is not available for this data.")
+  }
+
+  if (rlang::is_false(ref$exists)) {
+    cli::cli_abort(c(
+      "x" = "{ref$type} metadata not available.",
+      "i" = "Expected at {.path {ref$path}}"
+    ))
+  }
+
+  metadata <- read_file(
+    ref$path,
+    col_select = 1:2,
+    col_names = c("variable", "description"),
+    skip = 1,
+    col_types = readr::cols_only(
+      variable = readr::col_character(),
+      description = readr::col_character()
+    )
+  )
+
+  inform_metadata_version(ref$version)
+
+  # Attach metadata to the object
+  set_metadata(data, metadata)
+
+  metadata
+}
+
+set_metadata_ref <- function(data, path, type, version, exists) {
+  attr(data, "metadata_ref") <- list(
+    path = path,
+    type = type,
+    version = version,
+    exists = exists
+  )
+  data
+}
+
+set_metadata <- function(data, metadata) {
+  attr(data, "metadata") <- metadata
+  data
+}
+
+inform_metadata_access <- function(metadata) {
+  cli::cli_inform(c(
+    i = "Metadata is available and can be accessed using {.fun metadata}."
+  ))
+}
+
+inform_metadata_version <- function(version) {
+  if (version != "latest") {
+    cli::cli_warn(
+      "Metadata corresponds to the latest version of the data
+      and may not exactly match the data currently loaded."
+    )
+  }
+}

R/read_file.R

@@ -42,12 +42,14 @@ read_file <- function(path, col_select = NULL, ...) {
   }
 
   lookup <- switch(ext,
-    rds = tibble::as_tibble(readr::read_rds(file = path)),
-    csv = readr::read_csv(
+    "rds" = tibble::as_tibble(readr::read_rds(file = path)),
+    "csv" = readr::read_csv(
       file = path,
-      guess_max = 50000L,
-      ...,
-      show_col_types = FALSE
+      guess_max = 50000,
+      progress = FALSE,
+      show_col_types = FALSE,
+      lazy = .Platform$OS.type == "unix",
+      ...
     ),
     parquet = tibble::as_tibble(arrow::read_parquet(
       file = path,

tests/testthat/test-get_spd.R

@@ -2,7 +2,8 @@ skip_on_ci()
 
 test_that("spd is returned", {
   get_spd() |>
-    expect_message()
+    expect_message("Using the latest available version") |>
+    expect_message("Metadata is available ")
 
   spd <- suppressMessages(get_spd())
 
@@ -19,30 +20,36 @@ test_that("col selection works", {
     get_spd(col_select = "pc7"),
     "pc7"
   ) |>
-    expect_message()
+    expect_message("Using the latest available version") |>
+    expect_message("Metadata is available ")
   expect_named(
     get_spd(col_select = c("pc7", "pc8")),
     c("pc7", "pc8")
   ) |>
-    expect_message()
+    expect_message("Using the latest available version") |>
+    expect_message("Metadata is available ")
 })
 
 test_that("col selection works with tidyselect", {
   expect_named(
     get_spd(col_select = c("pc7", dplyr::starts_with("hb")))
   ) |>
-    expect_message()
+    expect_message("Using the latest available version") |>
+    expect_message("Metadata is available ")
 
   expect_named(
     get_spd(col_select = dplyr::matches("pc[78]")),
     c("pc7", "pc8")
   ) |>
-    expect_message()
+    expect_message("Using the latest available version") |>
+    expect_message("Metadata is available ")
 })
 
 
 test_that("reading from archive works", {
-  expect_s3_class(get_spd(version = "2024_1"), "tbl_df")
+  get_spd(version = "2024_1") |>
+    expect_s3_class("tbl_df") |>
+    expect_message("Metadata is available ")
   expect_error(get_spd(version = "2010_1", "SPD version .+? is NOT available"))
   expect_error(get_spd(version = "20243"), "Invalid version name:")
 })